guile/guile-core/libguile print.h print.c

[Marius Vollmer]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Marius Vollmer <address@hidden> 01/05/30 16:47:49

Modified files:
        guile-core/libguile: print.h print.c 

Log message:
        * print.c (scm_simple_format): Support "~~" and "~%".  Signal
        error for unsupported format controls and for superflous
        arguments.  Thanks to David Skarda!
        
        * print.h, print.c (scm_print_symbol_name): Factored out of
        scm_iprin1.
        (scm_iprin1): Call it.
        
        * print.c (scm_print_symbol_name): Symbols whose name starts with `#' 
or `:'
        or ends with `:' are considered weird.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/print.h.diff?cvsroot=OldCVS&tr1=1.35&tr2=1.36&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/print.c.diff?cvsroot=OldCVS&tr1=1.124&tr2=1.125&r1=text&r2=text

Patches:
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.124 
guile/guile-core/libguile/print.c:1.125
--- guile/guile-core/libguile/print.c:1.124     Sat May 26 13:51:21 2001
+++ guile/guile-core/libguile/print.c   Wed May 30 16:47:49 2001
@@ -305,12 +305,96 @@
   scm_putc ('#', port);
 }
 
+/* Print the name of a symbol. */
+
+void
+scm_print_symbol_name (const char *str, size_t len, SCM port)
+{
+  size_t pos;
+  size_t end;
+  int weird;
+  int maybe_weird;
+  size_t mw_pos = 0;
+  
+  pos = 0;
+  weird = 0;
+  maybe_weird = 0;
+  
+  /* XXX - Lots of weird symbol names are missed, such as "12" or
+     "'a". */
+
+  if (len == 0)
+    scm_lfwrite ("#{}#", 4, port);
+  else if (str[0] == '#' || str[0] == ':' || str[len-1] == ':')
+    {
+      scm_lfwrite ("#{", 2, port);
+      weird = 1;
+    }
+  
+  for (end = pos; end < len; ++end)
+    switch (str[end])
+      {
+#ifdef BRACKETS_AS_PARENS
+      case '[':
+      case ']':
+#endif
+      case '(':
+      case ')':
+      case '"':
+      case ';':
+      case SCM_WHITE_SPACES:
+      case SCM_LINE_INCREMENTORS:
+      weird_handler:
+       if (maybe_weird)
+         {
+           end = mw_pos;
+           maybe_weird = 0;
+         }
+       if (!weird)
+         {
+           scm_lfwrite ("#{", 2, port);
+           weird = 1;
+         }
+       if (pos < end)
+         {
+           scm_lfwrite (str + pos, end - pos, port);
+         }
+       {
+         char buf[2];
+         buf[0] = '\\';
+         buf[1] = str[end];
+         scm_lfwrite (buf, 2, port);
+       }
+       pos = end + 1;
+       break;
+      case '\\':
+       if (weird)
+         goto weird_handler;
+       if (!maybe_weird)
+         {
+           maybe_weird = 1;
+           mw_pos = pos;
+         }
+       break;
+      case '}':
+      case '#':
+       if (weird)
+         goto weird_handler;
+       break;
+      default:
+       break;
+      }
+  if (pos < end)
+    scm_lfwrite (str + pos, end - pos, port);
+  if (weird)
+    scm_lfwrite ("}#", 2, port);
+}
+
 /* Print generally.  Handles both write and display according to PSTATE.
  */
 SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write);
 SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display);
 
-
 void 
 scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 {
@@ -457,84 +541,11 @@
            scm_lfwrite (SCM_STRING_CHARS (exp), SCM_STRING_LENGTH (exp), port);
          break;
        case scm_tc7_symbol:
-           {
-             size_t pos;
-             size_t end;
-             size_t len;
-             char * str;
-             int weird;
-             int maybe_weird;
-             size_t mw_pos = 0;
-
-             len = SCM_SYMBOL_LENGTH (exp);
-             str = SCM_SYMBOL_CHARS (exp);
-             pos = 0;
-             weird = 0;
-             maybe_weird = 0;
-
-             if (len == 0)
-               scm_lfwrite ("#{}#", 4, port);
-
-             for (end = pos; end < len; ++end)
-               switch (str[end])
-                 {
-#ifdef BRACKETS_AS_PARENS
-                 case '[':
-                 case ']':
-#endif
-                 case '(':
-                 case ')':
-                 case '"':
-                 case ';':
-                 case SCM_WHITE_SPACES:
-                 case SCM_LINE_INCREMENTORS:
-                 weird_handler:
-                   if (maybe_weird)
-                     {
-                       end = mw_pos;
-                       maybe_weird = 0;
-                     }
-                   if (!weird)
-                     {
-                       scm_lfwrite ("#{", 2, port);
-                       weird = 1;
-                     }
-                   if (pos < end)
-                     {
-                       scm_lfwrite (str + pos, end - pos, port);
-                     }
-                   {
-                     char buf[2];
-                     buf[0] = '\\';
-                     buf[1] = str[end];
-                     scm_lfwrite (buf, 2, port);
-                   }
-                   pos = end + 1;
-                   break;
-                 case '\\':
-                   if (weird)
-                     goto weird_handler;
-                   if (!maybe_weird)
-                     {
-                       maybe_weird = 1;
-                       mw_pos = pos;
-                     }
-                   break;
-                 case '}':
-                 case '#':
-                   if (weird)
-                     goto weird_handler;
-                   break;
-                 default:
-                   break;
-                 }
-             if (pos < end)
-               scm_lfwrite (str + pos, end - pos, port);
-             scm_remember_upto_here_1 (exp);
-             if (weird)
-               scm_lfwrite ("}#", 2, port);
-             break;
-           }
+         scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
+                                SCM_SYMBOL_LENGTH (exp),
+                                port);
+         scm_remember_upto_here_1 (exp);
+         break;
        case scm_tc7_wvect:
          ENTER_NESTED_DATA (pstate, exp, circref);
          if (SCM_IS_WHVEC (exp))
@@ -942,25 +953,47 @@
   for (p = start; p != end; ++p)
     if (*p == '~')
       {
-       if (!SCM_CONSP (args))
-         continue;
-       
        if (++p == end)
-         continue;
-       
-       if (*p == 'A' || *p == 'a')
-         writingp = 0;
-       else if (*p == 'S' || *p == 's')
-         writingp = 1;
-       else
-         continue;
+         break;
 
+       switch (*p) 
+         {
+         case 'A': case 'a':
+           writingp = 0;
+           break;
+         case 'S': case 's':
+           writingp = 1;
+           break;
+         case '~':
+           scm_lfwrite (start, p - start, destination);
+           start = p + 1;
+           continue;
+         case '%':
+           scm_newline (destination);
+           start = p + 1;
+           continue;
+         default:
+           scm_misc_error (s_scm_simple_format, 
+               "FORMAT: Unsupported format option ~~~A - use (ice-9 format) 
instead",
+               SCM_LIST1 (SCM_MAKE_CHAR (*p)));
+           
+         }
+
+
+       if (!SCM_CONSP (args))
+         scm_misc_error (s_scm_simple_format, "FORMAT: Missing argument for 
~~~A",
+                         SCM_LIST1 (SCM_MAKE_CHAR (*p)));
+                                       
        scm_lfwrite (start, p - start - 1, destination);
        scm_prin1 (SCM_CAR (args), destination, writingp);
        args = SCM_CDR (args);
        start = p + 1;
       }
+
   scm_lfwrite (start, p - start, destination);
+  if (args != SCM_EOL)
+    scm_misc_error (s_scm_simple_format, 
+                   "FORMAT: ~A superfluous arguments", SCM_LIST1 (scm_length 
(args)));
 
   if (fReturnString)
     answer = scm_strport_to_string (destination);
Index: guile/guile-core/libguile/print.h
diff -u guile/guile-core/libguile/print.h:1.35 
guile/guile-core/libguile/print.h:1.36
--- guile/guile-core/libguile/print.h:1.35      Wed May 23 17:50:48 2001
+++ guile/guile-core/libguile/print.h   Wed May 30 16:47:49 2001
@@ -107,6 +107,7 @@
 extern void scm_intprint (long n, int radix, SCM port);
 extern void scm_ipruk (char *hdr, SCM ptr, SCM port);
 extern void scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, 
scm_print_state *pstate);
+extern void scm_print_symbol_name (const char *str, size_t len, SCM port);
 extern void scm_prin1 (SCM exp, SCM port, int writingp);
 extern void scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate);
 extern SCM scm_write (SCM obj, SCM port);