/[guile]/guile/guile-core/libguile/print.c
ViewVC logotype

Diff of /guile/guile-core/libguile/print.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.149 by mdj, Sat Apr 5 20:45:17 2003 UTC revision 1.150 by mdj, Mon May 12 20:46:52 2003 UTC
# Line 165  do { \ Line 165  do { \
165    
166  SCM scm_print_state_vtable = SCM_BOOL_F;  SCM scm_print_state_vtable = SCM_BOOL_F;
167  static SCM print_state_pool = SCM_EOL;  static SCM print_state_pool = SCM_EOL;
168    SCM_MUTEX (print_state_mutex);
169    
170  #ifdef GUILE_DEBUG /* Used for debugging purposes */  #ifdef GUILE_DEBUG /* Used for debugging purposes */
171    
# Line 204  scm_make_print_state () Line 205  scm_make_print_state ()
205    SCM answer = SCM_BOOL_F;    SCM answer = SCM_BOOL_F;
206    
207    /* First try to allocate a print state from the pool */    /* First try to allocate a print state from the pool */
208    SCM_DEFER_INTS;    scm_i_plugin_mutex_lock (&print_state_mutex);
209    if (!SCM_NULLP (print_state_pool))    if (!SCM_NULLP (print_state_pool))
210      {      {
211        answer = SCM_CAR (print_state_pool);        answer = SCM_CAR (print_state_pool);
212        print_state_pool = SCM_CDR (print_state_pool);        print_state_pool = SCM_CDR (print_state_pool);
213      }      }
214    SCM_ALLOW_INTS;    scm_i_plugin_mutex_unlock (&print_state_mutex);
215        
216    return SCM_FALSEP (answer) ? make_print_state () : answer;    return SCM_FALSEP (answer) ? make_print_state () : answer;
217  }  }
# Line 227  scm_free_print_state (SCM print_state) Line 228  scm_free_print_state (SCM print_state)
228     */     */
229    pstate->fancyp = 0;    pstate->fancyp = 0;
230    pstate->revealed = 0;    pstate->revealed = 0;
231    SCM_DEFER_INTS;    scm_i_plugin_mutex_lock (&print_state_mutex);
232    handle = scm_cons (print_state, print_state_pool);    handle = scm_cons (print_state, print_state_pool);
233    print_state_pool = handle;    print_state_pool = handle;
234    SCM_ALLOW_INTS;    scm_i_plugin_mutex_unlock (&print_state_mutex);
235    }
236    
237    SCM
238    scm_i_port_with_print_state (SCM port, SCM print_state)
239    {
240      if (SCM_UNBNDP (print_state))
241        {
242          if (SCM_PORT_WITH_PS_P (port))
243            return port;
244          else
245            print_state = scm_make_print_state ();
246          /* port does not need to be coerced since it doesn't have ps */
247        }
248      else
249        port = SCM_COERCE_OUTPORT (port);
250      SCM_RETURN_NEWSMOB (scm_tc16_port_with_ps,
251                          SCM_UNPACK (scm_cons (port, print_state)));
252  }  }
253    
254  static void  static void
# Line 434  scm_iprin1 (SCM exp, SCM port, scm_print Line 452  scm_iprin1 (SCM exp, SCM port, scm_print
452                  SCM pwps, print = pstate->writingp ? g_write : g_display;                  SCM pwps, print = pstate->writingp ? g_write : g_display;
453                  if (!print)                  if (!print)
454                    goto print_struct;                    goto print_struct;
455                  SCM_NEWSMOB (pwps,                  pwps = scm_i_port_with_print_state (port, pstate->handle);
                              scm_tc16_port_with_ps,  
                              SCM_UNPACK (scm_cons (port, pstate->handle)));  
456                  pstate->revealed = 1;                  pstate->revealed = 1;
457                  scm_call_generic_2 (print, exp, pwps);                  scm_call_generic_2 (print, exp, pwps);
458                }                }
# Line 670  scm_prin1 (SCM exp, SCM port, int writin Line 686  scm_prin1 (SCM exp, SCM port, int writin
686    else    else
687      {      {
688        /* First try to allocate a print state from the pool */        /* First try to allocate a print state from the pool */
689        SCM_DEFER_INTS;        scm_i_plugin_mutex_lock (&print_state_mutex);
690        if (!SCM_NULLP (print_state_pool))        if (!SCM_NULLP (print_state_pool))
691          {          {
692            handle = print_state_pool;            handle = print_state_pool;
693            print_state_pool = SCM_CDR (print_state_pool);            print_state_pool = SCM_CDR (print_state_pool);
694          }          }
695        SCM_ALLOW_INTS;        scm_i_plugin_mutex_unlock (&print_state_mutex);
696        if (SCM_FALSEP (handle))        if (SCM_FALSEP (handle))
697          handle = scm_list_1 (make_print_state ());          handle = scm_list_1 (make_print_state ());
698        pstate_scm = SCM_CAR (handle);        pstate_scm = SCM_CAR (handle);
# Line 693  scm_prin1 (SCM exp, SCM port, int writin Line 709  scm_prin1 (SCM exp, SCM port, int writin
709    
710    if (!SCM_FALSEP (handle) && !pstate->revealed)    if (!SCM_FALSEP (handle) && !pstate->revealed)
711      {      {
712        SCM_DEFER_INTS;        scm_i_plugin_mutex_lock (&print_state_mutex);
713        SCM_SETCDR (handle, print_state_pool);        SCM_SETCDR (handle, print_state_pool);
714        print_state_pool = handle;        print_state_pool = handle;
715        SCM_ALLOW_INTS;        scm_i_plugin_mutex_unlock (&print_state_mutex);
716      }      }
717  }  }
718    
# Line 900  SCM_DEFINE (scm_simple_format, "simple-f Line 916  SCM_DEFINE (scm_simple_format, "simple-f
916              "containing the formatted text. Does not add a trailing newline.")              "containing the formatted text. Does not add a trailing newline.")
917  #define FUNC_NAME s_scm_simple_format  #define FUNC_NAME s_scm_simple_format
918  {  {
919    SCM answer = SCM_UNSPECIFIED;    SCM port, answer = SCM_UNSPECIFIED;
920    int fReturnString = 0;    int fReturnString = 0;
921    int writingp;    int writingp;
922    char *start;    char *start;
# Line 909  SCM_DEFINE (scm_simple_format, "simple-f Line 925  SCM_DEFINE (scm_simple_format, "simple-f
925    
926    if (SCM_EQ_P (destination, SCM_BOOL_T))    if (SCM_EQ_P (destination, SCM_BOOL_T))
927      {      {
928        destination = scm_cur_outp;        destination = port = scm_cur_outp;
929      }      }
930    else if (SCM_FALSEP (destination))    else if (SCM_FALSEP (destination))
931      {      {
932        fReturnString = 1;        fReturnString = 1;
933        destination = scm_mkstrport (SCM_INUM0,        port = scm_mkstrport (SCM_INUM0,
934                                     scm_make_string (SCM_INUM0, SCM_UNDEFINED),                              scm_make_string (SCM_INUM0, SCM_UNDEFINED),
935                                     SCM_OPN | SCM_WRTNG,                              SCM_OPN | SCM_WRTNG,
936                                     FUNC_NAME);                              FUNC_NAME);
937          destination = port;
938      }      }
939    else    else
940      {      {
941        SCM_VALIDATE_OPORT_VALUE (1, destination);        SCM_VALIDATE_OPORT_VALUE (1, destination);
942        destination = SCM_COERCE_OUTPORT (destination);        port = SCM_COERCE_OUTPORT (destination);
943      }      }
944    SCM_VALIDATE_STRING (2, message);    SCM_VALIDATE_STRING (2, message);
945    SCM_VALIDATE_REST_ARGUMENT (args);    SCM_VALIDATE_REST_ARGUMENT (args);
# Line 944  SCM_DEFINE (scm_simple_format, "simple-f Line 961  SCM_DEFINE (scm_simple_format, "simple-f
961              writingp = 1;              writingp = 1;
962              break;              break;
963            case '~':            case '~':
964              scm_lfwrite (start, p - start, destination);              scm_lfwrite (start, p - start, port);
965              start = p + 1;              start = p + 1;
966              continue;              continue;
967            case '%':            case '%':
968              scm_lfwrite (start, p - start - 1, destination);              scm_lfwrite (start, p - start - 1, port);
969              scm_newline (destination);              scm_newline (port);
970              start = p + 1;              start = p + 1;
971              continue;              continue;
972            default:            default:
# Line 963  SCM_DEFINE (scm_simple_format, "simple-f Line 980  SCM_DEFINE (scm_simple_format, "simple-f
980            SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",            SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
981                            scm_list_1 (SCM_MAKE_CHAR (*p)));                            scm_list_1 (SCM_MAKE_CHAR (*p)));
982                                                                                    
983          scm_lfwrite (start, p - start - 1, destination);          scm_lfwrite (start, p - start - 1, port);
984            /* we pass destination here */
985          scm_prin1 (SCM_CAR (args), destination, writingp);          scm_prin1 (SCM_CAR (args), destination, writingp);
986          args = SCM_CDR (args);          args = SCM_CDR (args);
987          start = p + 1;          start = p + 1;
988        }        }
989    
990    scm_lfwrite (start, p - start, destination);    scm_lfwrite (start, p - start, port);
991    if (!SCM_EQ_P (args, SCM_EOL))    if (!SCM_EQ_P (args, SCM_EOL))
992      SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments",      SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments",
993                      scm_list_1 (scm_length (args)));                      scm_list_1 (scm_length (args)));
# Line 1044  port_with_ps_print (SCM obj, SCM port, s Line 1062  port_with_ps_print (SCM obj, SCM port, s
1062  SCM  SCM
1063  scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate)  scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *pstate)
1064  {  {
   SCM pwps;  
   SCM pair = scm_cons (port, pstate->handle);  
   SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (pair));  
1065    pstate->revealed = 1;    pstate->revealed = 1;
1066    return scm_call_2 (proc, exp, pwps);    return scm_call_2 (proc, exp,
1067                         scm_i_port_with_print_state (port, pstate->handle));
1068  }  }
1069    
1070  SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 2, 0, 0,  SCM_DEFINE (scm_port_with_print_state, "port-with-print-state", 1, 1, 0,
1071              (SCM port, SCM pstate),              (SCM port, SCM pstate),
1072              "Create a new port which behaves like @var{port}, but with an\n"              "Create a new port which behaves like @var{port}, but with an\n"
1073              "included print state @var{pstate}.")              "included print state @var{pstate}.  @var{pstate} is optional.\n"
1074                "If @var{pstate} isn't supplied and @var{port} already has\n"
1075                "a print state, the old print state is reused.")
1076  #define FUNC_NAME s_scm_port_with_print_state  #define FUNC_NAME s_scm_port_with_print_state
1077  {  {
   SCM pwps;  
1078    SCM_VALIDATE_OPORT_VALUE (1, port);    SCM_VALIDATE_OPORT_VALUE (1, port);
1079    SCM_VALIDATE_PRINTSTATE (2, pstate);    if (!SCM_UNBNDP (pstate))
1080    port = SCM_COERCE_OUTPORT (port);      SCM_VALIDATE_PRINTSTATE (2, pstate);
1081    SCM_NEWSMOB (pwps, scm_tc16_port_with_ps, SCM_UNPACK (scm_cons (port, pstate)));    return scm_i_port_with_print_state (port, pstate);
   return pwps;  
1082  }  }
1083  #undef FUNC_NAME  #undef FUNC_NAME
1084    

Legend:
Removed from v.1.149  
changed lines
  Added in v.1.150

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26