home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / comp / lang / tcl / 1039 < prev    next >
Encoding:
Text File  |  1992-07-23  |  8.3 KB  |  295 lines
  1. Newsgroups: comp.lang.tcl
  2. Path: sparky!uunet!zaphod.mps.ohio-state.edu!pacific.mps.ohio-state.edu!linac!att!cbnewsm!grenache!gah
  3. From: gah@grenache (George A. Howlett)
  4. Subject: Tcl 6.3 "expr" patch to add "OFMT" variable 
  5. Reply-To: george.howlett@att.com
  6. Organization: AT&T Bell Laboratories
  7. Date: Thu, 23 Jul 1992 16:26:59 GMT
  8. Message-ID: <1992Jul23.162659.4183@cbnewsm.cb.att.com>
  9. X-Newsreader: Tin 1.1 PL4
  10. Sender: news@cbnewsm.cb.att.com (NetNews Administrator)
  11. Nntp-Posting-Host: grenache.cnet.att.com
  12. Lines: 281
  13.  
  14. This patch adds a global Tcl variable "OFMT" which controls the
  15. conversion format of floating point values from the "expr" command.
  16. The default value is "%g" (what is currently in tclExpr.c).  This
  17. means that existing code should perform as expected.  New values for
  18. "OFMT" must be valid format strings to convert floating point values.
  19. There can be no auxiliary width or precision arguments (using "*").
  20. There can be no extra characters.  If "OFMT" is unset, the value of
  21. "OFMT" reverts back to the default.
  22.  
  23. This patch is baselined on the distributed verion of tclExpr.c and
  24. tclBasic.c in Tcl 6.3.  Mail comments or bug reports back to
  25. "george.howlett@att.com".
  26.  
  27. --gah 
  28.  
  29. *** tclBasic.c-dist    Mon Feb 10 12:29:43 1992
  30. --- tclBasic.c    Mon Jun 22 15:18:34 1992
  31. ***************
  32. *** 130,135 ****
  33. --- 130,136 ----
  34.   Tcl_Interp *
  35.   Tcl_CreateInterp()
  36.   {
  37. +     extern Tcl_VarTraceProc OutputFormatProc;
  38.       register Interp *iPtr;
  39.       register Command *cmdPtr;
  40.       register CmdInfo *cmdInfoPtr;
  41. ***************
  42. *** 193,199 ****
  43.   #ifndef TCL_GENERIC_ONLY
  44.       TclSetupEnv((Tcl_Interp *) iPtr);
  45.   #endif
  46. ! 
  47.       return (Tcl_Interp *) iPtr;
  48.   }
  49.   
  50. --- 194,202 ----
  51.   #ifndef TCL_GENERIC_ONLY
  52.       TclSetupEnv((Tcl_Interp *) iPtr);
  53.   #endif
  54. !     Tcl_TraceVar2 ((Tcl_Interp *) iPtr, "OFMT", (char *)NULL, 
  55. !            (TCL_TRACE_WRITES | TCL_TRACE_UNSETS), OutputFormatProc, 
  56. !            (ClientData) NULL);
  57.       return (Tcl_Interp *) iPtr;
  58.   }
  59.   
  60. *** tclExpr.c-dist    Mon Mar 23 12:54:06 1992
  61. --- tclExpr.c    Thu Jul 23 12:07:53 1992
  62. ***************
  63. *** 157,162 ****
  64. --- 157,176 ----
  65.       "-", "!", "~"
  66.   };
  67.   
  68. + 
  69. + /* Default format conversion string */
  70. + static char defFmt[] = "%g";
  71. + 
  72. + /* 
  73. +  * Floating point output format conversion string.
  74. +  *
  75. +  * This probably should be part of the interpreter itself (as a
  76. +  * Tcl or C variable), so that multiple interpreters can have 
  77. +  * multiple formats. 
  78. +  *
  79. +  */
  80. + static char *OFMT = defFmt;
  81. + 
  82.   /*
  83.    * Declarations for local procedures to this file:
  84.    */
  85. ***************
  86. *** 1124,1130 ****
  87.       if (valuePtr->type == TYPE_INT) {
  88.       sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue);
  89.       } else if (valuePtr->type == TYPE_DOUBLE) {
  90. !     sprintf(valuePtr->pv.buffer, "%g", valuePtr->doubleValue);
  91.       }
  92.       valuePtr->type = TYPE_STRING;
  93.   }
  94. --- 1138,1144 ----
  95.       if (valuePtr->type == TYPE_INT) {
  96.       sprintf(valuePtr->pv.buffer, "%ld", valuePtr->intValue);
  97.       } else if (valuePtr->type == TYPE_DOUBLE) {
  98. !     sprintf(valuePtr->pv.buffer, OFMT, valuePtr->doubleValue);
  99.       }
  100.       valuePtr->type = TYPE_STRING;
  101.   }
  102. ***************
  103. *** 1318,1324 ****
  104.       if (value.type == TYPE_INT) {
  105.           sprintf(interp->result, "%ld", value.intValue);
  106.       } else if (value.type == TYPE_DOUBLE) {
  107. !         sprintf(interp->result, "%g", value.doubleValue);
  108.       } else {
  109.           if (value.pv.buffer != value.staticSpace) {
  110.           interp->result = value.pv.buffer;
  111. --- 1332,1338 ----
  112.       if (value.type == TYPE_INT) {
  113.           sprintf(interp->result, "%ld", value.intValue);
  114.       } else if (value.type == TYPE_DOUBLE) {
  115. !         sprintf(interp->result, OFMT, value.doubleValue);
  116.       } else {
  117.           if (value.pv.buffer != value.staticSpace) {
  118.           interp->result = value.pv.buffer;
  119. ***************
  120. *** 1334,1336 ****
  121. --- 1348,1519 ----
  122.       }
  123.       return result;
  124.   }
  125. + 
  126. + 
  127. + /*
  128. +  *----------------------------------------------------------------------
  129. +  *
  130. +  * VerifyFormat --
  131. +  *
  132. +  *      Check the format conversion string used to convert floating
  133. +  *    point numbers.  The given format must be a valid floating
  134. +  *    point conversion string.  There can be no other conversions
  135. +  *    or extra characters in the description.  In addition, it cannot
  136. +  *    have extra width or precision integer arguments (using '*').
  137. +  *
  138. +  * Results:
  139. +  *      A standard Tcl result.
  140. +  *
  141. +  * Side effects:
  142. +  *      See the user documentation.
  143. +  *
  144. +  *----------------------------------------------------------------------
  145. +  */
  146. + static int
  147. + VerifyFormat(interp, newFormat)
  148. +     Tcl_Interp *interp;         /* Interpreter to report errors to */
  149. +     char *newFormat;         /* New conversion format to be tested */
  150. + {
  151. +     register char *format;
  152. + 
  153. +     format = newFormat;
  154. + 
  155. +     if ((*format != '%') || (format[1] == '%')) {
  156. +         interp->result = "format string can't specify non-numeric format";
  157. +     return TCL_ERROR;
  158. +     }
  159. +     format++;
  160. + 
  161. +     /* Zero or more flags, which modify the conversion. */
  162. +     while ((*format == '-') || (*format == '#') || (*format == '+')
  163. +        || (*format == ' ')) {
  164. +           format++;
  165. +     }
  166. + 
  167. +     /* Optional decimal digit string specifying field width... */
  168. +     if (*format == '0') {
  169. +         format++;
  170. +     }
  171. +     if (*format == '*') {
  172. +         interp->result = 
  173. +       "format string can't specify integer (*) width argument";
  174. +     return TCL_ERROR;
  175. +     }
  176. +     while (isdigit(*format)) {
  177. +         format++;
  178. +     }
  179. + 
  180. +     /* A precision that give the minimum numnber of digits to appear... */
  181. +     if (*format == '.') {
  182. +         format++;
  183. +     }
  184. +     if (*format == '*') {
  185. +         interp->result =
  186. +       "format string can't specify integer (*) precision argument";
  187. +     return TCL_ERROR;    /* Can't allow '*' in precision */
  188. +     }
  189. +     while (isdigit(*format)) {
  190. +         format++;
  191. +     }
  192. +     if (*format == 'l') {/* Ansi long specifier */
  193. +         format++;
  194. +     }
  195. +     switch (*format) {
  196. +     case 'D':
  197. +     case 'O':
  198. +     case 'U':
  199. +     case 'd':
  200. +     case 'o':
  201. +     case 'u':
  202. +     case 'x':
  203. +     case 'X':
  204. +     case 's':
  205. +     case 'c':
  206. +         interp->result = 
  207. +       "format string must specify floating point conversion";
  208. +     return TCL_ERROR;
  209. +     case 'e':
  210. +     case 'E':
  211. +     case 'f':
  212. +     case 'g':
  213. +     case 'G':
  214. +     break;
  215. +     case 0:
  216. +     interp->result = "format string ended in middle of field specifier";
  217. +     return TCL_ERROR;
  218. +     default:
  219. +     interp->result = "bad field specifier";
  220. +     return TCL_ERROR;
  221. +     }
  222. +     format++;
  223. +     if (*format != '\0') {
  224. +     interp->result = "found extra characters in format string";
  225. +     return TCL_ERROR;
  226. +     }
  227. +     return TCL_OK;
  228. + }
  229. + 
  230. + /*
  231. +  *----------------------------------------------------------------------
  232. +  *
  233. +  * OutputFormatProc --
  234. +  *
  235. +  *      This procedure is invoked when the global Tcl variable "OFMT"
  236. +  *    is written to or unset.  It sets the format conversion string
  237. +  *    which is used in tclExpr.c. The default format is "%g".
  238. +  *
  239. +  * Results:
  240. +  *      NULL is a valid output format string was given.
  241. +  *
  242. +  * Side effects:
  243. +  *      See the user documentation.
  244. +  *
  245. +  *----------------------------------------------------------------------
  246. +  */
  247. + 
  248. + /*ARGSUSED*/
  249. + char *
  250. + OutputFormatProc(clientData, interp, name1, name2, flags)
  251. +     ClientData clientData;   /* not used */
  252. +     Tcl_Interp *interp;
  253. +     char *name1;
  254. +     char *name2;         /* not used */
  255. +     int flags;
  256. + {
  257. +     if (flags & TCL_TRACE_UNSETS) {
  258. +     if (OFMT != defFmt)
  259. +         free (OFMT);
  260. +         OFMT = defFmt;
  261. +     if (flags & TCL_TRACE_DESTROYED) {     /* Restore the trace */
  262. +         Tcl_TraceVar2 (interp, name1, name2, 
  263. +                (TCL_TRACE_WRITES | TCL_TRACE_UNSETS), 
  264. +                OutputFormatProc, (ClientData) NULL);
  265. +     }
  266. +     } else if (flags & TCL_TRACE_WRITES) {
  267. +         char *newFmt;
  268. +     char *fmt;
  269. +     
  270. +     newFmt = Tcl_GetVar2(interp, name1, name2,
  271. +                 flags & (TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY));
  272. +     if (newFmt == NULL) {
  273. +         return (interp->result);
  274. +     }
  275. +     /* Test the conversion format string */
  276. +     if (VerifyFormat(interp, newFmt) != TCL_OK) {
  277. +         /* Restore variable to the previous valid value */
  278. +         Tcl_SetVar2 (interp, name1, name2, OFMT, flags & TCL_GLOBAL_ONLY);
  279. +         return (interp->result);
  280. +     }
  281. +     fmt = (char *)malloc(strlen(newFmt) + 1);
  282. +     if (fmt == NULL) {
  283. +         return "Can't allocate format string";
  284. +     }
  285. +     strcpy(fmt, newFmt);
  286. +     if (OFMT != defFmt)
  287. +         free (OFMT);
  288. +     OFMT = fmt;
  289. +     }
  290. +     return (NULL);
  291. + }
  292. + 
  293. + 
  294.  
  295.