source: tol/toltcl/generic/toltime.cpp @ 2f5c82f1

1941-docker-image-to-testdevel
Last change on this file since 2f5c82f1 was c14b554, checked in by Jorge Pérez <josp.jorge@…>, 18 years ago

merging from NameBlock/VMatrix branch

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@4 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 14.8 KB
RevLine 
[6d7779d]1/* toltime.cpp - GNU/tolTcl Library
2
3   Copyright (C) 2001, 2002, 2003 - Bayes Decisión, SL (Spain [EU])
4
5   This program is free software; you can redistribute it and/or modify
6   it under the terms of the GNU General Public License as published by
7   the Free Software Foundation; either version 2, or (at your option)
8   any later version.
9
10   This program is distributed in the hope that it will be useful,
11   but WITHOUT ANY WARRANTY; without even the implied warranty of
12   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13   GNU General Public License for more details.
14
15   You should have received a copy of the GNU General Public License
16   along with this program; if not, write to the Free Software
17   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
18   USA.
19 */
20
21#if defined(_MSC_VER)
22#include <win_tolinc.h>
23#endif
24#include <tol/tol_blanguag.h>
25#include <tol/tol_btmsgra.h>
26
27#include <toltclInt.h>
28
29struct TMS_ClientData {
30
31  /* timeset iterated */
32
33  BUserTimeSet * uts;
34  BDate current;
35
36  /* token used to remove the command */
37 
38  Tcl_Command cmd_token;
39
40  void Init( BUserTimeSet * t) {
41    if ( (uts = t) ) {
42      uts->IncNRefs();
43      Start( BDate::DefaultFirst() );
44    }
45  }
46  void Destroy() {
47    if ( uts ) {
48      uts->DecNRefs();
49      /* destroy in case NRefs has reached 0 */
50      DESTROY(uts);
51      uts = NULL;
52    }
53  }
54  void Start ( BDate & d ) {
55    if ( uts )
56      current = uts->FirstNoLess( d );
57  }
58  void Start ( char * txt ) {
59    if ( txt )
60      current.PutDate( txt );
61    else
62      current = BDate::DefaultFirst();
63    if ( uts )
64      current = uts->FirstNoLess( current );
65  }
66  BDate & Get () {
67    return current;
68  }
69  BDate & Next () {
70    if ( uts )
71      current = uts->Successor( current );
72    return current;
73  }
74  BDate & Previous () {
75    if ( uts )
76      current = uts->Predecessor( current );
77    //current -= uts;
78    return current;
79  }
80  int HasValue () {
81    return current.HasValue();
82  }
83  int    Year()       const { return current.Year();  }
84  int  Month()      const { return current.Month(); }
85  int    Day()        const { return current.Day();   }
86  int    Hour()       const { return current.Hour(); }
87  int    Minute()     const { return current.Minute(); }
88  double         Second()     const { return current.Second(); }
89#if defined(_TOL_FROZEN_)
90  int Contain( BDate & d ) { return uts->Contain( d ); }
91#else
92  int Contain( BDate & d ) { return uts->Contain( d, BTRUE ); }
93#endif
94};
95
96static
97int Tol_TMSInstanceProc _ANSI_ARGS_((ClientData clientData,
98                                    Tcl_Interp *interp,
99                                    int objc, Tcl_Obj *CONST objv[]));
100
101static
102void Tol_TMSDelInstanceProc _ANSI_ARGS_((ClientData clientData));
103
104/*
105 *  Create a new command to access the given TOL timeset object name.
106 *
107 */
108
109int Tol_CreateTMSCmd( Tcl_Interp * interp, Tcl_Obj * tmscmd,
110                      Tcl_Obj * tmsname, Tcl_Obj * obj_result )
111{
112  const BSyntaxObject * tol_obj;
113  BUserTimeSet * uts;
114  Tcl_CmdInfo cmd_info;
115  char * str_tmscmd = Tcl_GetString(tmscmd);
116 
117  if (!*str_tmscmd) {
118    Tcl_AppendStringsToObj(obj_result,
119                           "invalid timeset command name: must be not empty",
120                           NULL);
121    return TCL_ERROR;
122  }
123 
124  /* verify if tmscmd already exists as a command */
125 
126  if (Tcl_GetCommandInfo(interp,str_tmscmd,&cmd_info) &&
127    (cmd_info.objProc == Tol_TMSInstanceProc)) {
128    Tcl_AppendStringsToObj(obj_result, "\"",str_tmscmd,"\"",
129                           "already exists as timeset command",NULL);
130    return TCL_ERROR;
131  }
132
133  /* now look for tms in tol */
134
135  BGrammar * gra = GraTimeSet();
136
137  if ( !gra ) {
138    Tcl_AppendStringsToObj( obj_result,
139                            "TimeSet grammar not found", NULL );
140    return TCL_ERROR;
141  }
142
[c14b554]143  if (!(tol_obj=Tol_ResolveObject(interp, tmsname, obj_result/*, gra*/))) {
[6d7779d]144    return TCL_ERROR;
145  }
146
147  uts = (BUserTimeSet *)tol_obj;
148
149  TMS_ClientData *clientData = (TMS_ClientData*)Tcl_Alloc(sizeof(TMS_ClientData));
150
151  if (!clientData)
152    return TCL_ERROR;
153
154  clientData->Init(uts);
155  clientData->cmd_token = Tcl_CreateObjCommand( interp,
156                                                str_tmscmd,
157                                                &Tol_TMSInstanceProc,
158                                                (ClientData)clientData,
159                                                &Tol_TMSDelInstanceProc );
160 
161  return TCL_OK;
162}
163
164/*
165 * Destroy the tcl tms commands given in objv.
166 *
167 */
168
169int Tol_DestroyTMSCmd( Tcl_Interp * interp,
170                       int objc, Tcl_Obj *CONST objv[],
171                       Tcl_Obj * obj_result )
172{
173  Tcl_CmdInfo cmd_info;
174  char * cmdname;
175 
176  for (int i=0; i<objc; ++i) {
177    cmdname = Tcl_GetString(objv[i]);
178    if ( Tcl_GetCommandInfo(interp,cmdname,&cmd_info) &&
179         (cmd_info.objProc == Tol_TMSInstanceProc) ) {
180      if (Tcl_DeleteCommand(interp,cmdname) == -1) {
181        Tcl_AppendStringsToObj( obj_result,
182                                "could not delete \"",cmdname,"\"",NULL);
183        return TCL_ERROR;
184      }
185    } else {
186      Tcl_AppendStringsToObj( obj_result,
187                              "can't find timeset command \"",
188                              cmdname,"\"",NULL);
189      return TCL_ERROR;
190    }
191  }
192
193  return TCL_OK;
194}
195
196int Tol_TMSInstanceProc( ClientData clientData,
197                         Tcl_Interp *interp,
198                         int objc, Tcl_Obj *CONST objv[])
199{
200  char * cmd_name = Tcl_GetString( objv[0] );
201
202  if ( objc < 2 || objc > 3 ) {
203    Tcl_AppendResult( interp, "wrong # args: should be\n",
204                      cmd_name, " contain date\n",
205                      cmd_name, " start date\n",
206                      cmd_name, " get\n",
207                      cmd_name, " next\n",
208                      cmd_name, " previous",
209                      NULL );
210    return TCL_ERROR;
211  }
212
213  char * option = Tcl_GetString( objv[1] );
214  int len = strlen( option );
215  TMS_ClientData * tmsData = (TMS_ClientData *)clientData;
216  int tcl_code = TCL_OK;
217  BDate dte;
218
219  if ( !strncmp( "contain", option, len ) ) {
220    if ( objc != 3 ) {
221      Tcl_AppendResult( interp, "wrong # args: should be, ",
222                        cmd_name, " contain date", NULL );
223      tcl_code = TCL_ERROR;
224    } else {
225      tcl_code = Tol_ListToDate( interp, objv[2], dte,
226                                 Tcl_GetObjResult(interp) );
227      if ( tcl_code == TCL_OK )
228        Tcl_SetIntObj( Tcl_GetObjResult(interp),
229                       tmsData->Contain( dte ) );
230    }
231    return tcl_code;
232  } else if ( !strncmp( "start", option, len ) ) {
233    if ( objc != 3 ) {
234      Tcl_AppendResult( interp, "wrong # args: should be, ",
235                        cmd_name, " start date", NULL );
236      tcl_code = TCL_ERROR;
237    } else {
238      tcl_code = Tol_ListToDate( interp, objv[2], dte,
239                                 Tcl_GetObjResult(interp) );
240      if ( tcl_code == TCL_OK )
241        tmsData->Start( dte );
242    }
243  } else {
244    if ( objc != 2 ) {
245      Tcl_AppendResult( interp, "wrong # args: should be, ",
246                        cmd_name, " get\n",
247                        cmd_name, " next\n",
248                        cmd_name, " previous", NULL );
249      tcl_code = TCL_ERROR;
250    } else if ( !strncmp( "next", option, len ) ) {
251      tmsData->Next();
252    } else if ( !strncmp( "previous", option, len ) ) {
253      tmsData->Previous();
254    } else if ( strncmp( "get", option, len ) ) {
255      Tcl_AppendResult( interp, "invalid option '",
256                        option,
257                        "', should be: start, get, next or previous", NULL );
258      tcl_code = TCL_ERROR;
259    }
260  }
261
262  if ( tcl_code != TCL_ERROR ) {
263    if ( tmsData->HasValue() )
264      tcl_code = Tol_DateToList( tmsData->Get(), Tcl_GetObjResult(interp) );
265    else
266      Tcl_SetResult( interp, "-1 -1 -1 -1 -1 -1", TCL_VOLATILE );
267  }
268  return tcl_code;
269}
270
271void Tol_TMSDelInstanceProc( ClientData clientData )
272{
273   TMS_ClientData * tmsData = (TMS_ClientData*)clientData;
274
275   if ( tmsData )
276      tmsData->Destroy();
277}
278
279
280/*
281 *  Implement tol::date
282 *
283 *       tol::date first              -> default first date
284 *       tol::date last               -> default last  date
285 *       tol::date now     ?fmt?       -> today date/time
286 *       tol::date weekday date        -> 0(sunday), 1(monday), ..., 6(saturday)
287 *       tol::date nod     year month  -> number of days of month/year
288 *       tol::date +day    date ?n?    -> date ++ ?n days?
289 *       tol::date +month  date ?n?    -> date ++ ?n months?
290 *
291 *  Results:
292 *       a valid date
293 *
294 *       date is always a list {Y M D h m s}
295 *
296 */
297
298int Tol_DateOption( Tcl_Interp * interp,
299                    int objc, Tcl_Obj *CONST objv[],
300                    Tcl_Obj * obj_result )
301{
302  char * cmd = Tcl_GetString( objv[0] );
303  if ( objc < 2 || objc > 4 ) {
304    Tcl_AppendStringsToObj( obj_result, "wrong # args, should be:\n",
305                            cmd, " first\n",
306                            cmd, " last\n",
307                            cmd, " now ?fmt?\n",
308                            cmd, " weekday date\n",
309                            cmd, " days year month\n",
310                            cmd, " +day date ?n?\n",
311                            cmd, " +month date ?n?\n", NULL );
312    return TCL_ERROR;
313  }
314
315  char * option = Tcl_GetString( objv[1] );
316  int len = strlen( option );
317  int tcl_code = TCL_OK;
318  int opt_code;
319  int min_args;
320  int max_args;
321
322#define OPT_UNKNOWN   -1
323#define OPT_FIRST     0
324#define OPT_LAST      1
325#define OPT_NOW       2
326#define OPT_WEEKDAY   3
327#define OPT_DAYS      4
328#define OPT_INCDAYS   5
329#define OPT_INCMONTHS 6
330
331  objc -= 2;
332  objv += 2;
333  opt_code = OPT_UNKNOWN;
334  min_args = 0;
335  max_args = 0;
336
337  if ( !strncmp( "first", option, len ) )
338    opt_code = OPT_FIRST;
339  else if ( !strncmp( "last", option, len ) )
340    opt_code = OPT_LAST;
341  else if ( !strncmp( "now", option, len ) ) {
342    opt_code = OPT_NOW;
343    min_args = 0; max_args = 1;
344  } else if ( !strncmp( "weekday", option, len ) ) {
345    opt_code = OPT_WEEKDAY;
346    min_args = max_args = 1;
347  } else if ( !strncmp( "days", option, len ) ) {
348    opt_code = OPT_DAYS;
349    min_args = max_args = 2;
350  } else if ( !strncmp( "+day", option, len ) ) {
351    opt_code = OPT_INCDAYS;
352    min_args = 1;
353    max_args = 2;
354  } else if ( !strncmp( "+month", option, len ) ) {
355    opt_code = OPT_INCMONTHS;
356    min_args = 1;
357    max_args = 2;
358  } else {
359    Tcl_AppendStringsToObj( obj_result,
360      "invalid option, should be: first, last, now, weekday, days, +day or +month",
361      NULL );
362    return TCL_ERROR;
363  }
364
365  if ( objc < min_args || objc > max_args ) {
366    Tcl_AppendStringsToObj( obj_result,
367      "wrong # args calling '", cmd, " ", option, "'", NULL );
368    return TCL_ERROR;
369  }
370
371  BDate date;
372  int YM[2], i;
373
374  switch ( opt_code ) {
375  case OPT_FIRST:
376    date = BDate::DefaultFirst();
377    break;
378  case OPT_LAST:
379    date = BDate::DefaultLast();
380    break;
381  case OPT_NOW:
382    date = DteNow();
383    if (objc == 1) {
384      char * fmt = Tcl_GetString( objv[0] );
385      if ( *fmt ) {
386        BDateFormat bformat( fmt );
387        BText dfmt( bformat.DateToText(date) );
388        Tcl_AppendStringsToObj( obj_result, dfmt.Buffer(), NULL );
389        return TCL_OK;
390      }
391    }
392    break;
393  case OPT_WEEKDAY:
394    tcl_code = Tol_ListToDate( interp, objv[0], date, obj_result );
395    if ( tcl_code != TCL_OK )
396      return TCL_ERROR;
397    Tcl_SetIntObj( obj_result, date.WeekDay() % 7 );
398    return TCL_OK;
399  case OPT_DAYS:
400    for ( i = 0; i < 2; i++ ) {
401      tcl_code = Tcl_GetIntFromObj( interp, objv[i], YM+i );
402      if ( tcl_code != TCL_OK ) {
403        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
404        return TCL_ERROR;
405      }
406    }
407    date.PutDate( YM[0], YM[1] );
408    if ( !date.HasValue() ) {
409      Tcl_AppendStringsToObj( obj_result, "Invalid month '",
410        Tcl_GetString(objv[0]), "-", Tcl_GetString(objv[1]),
411        "'", NULL );
412      return TCL_ERROR;
413    }
414    Tcl_SetIntObj( obj_result, DteDaysInMonth( YM[1], YM[0] ) );
415    return TCL_OK;
416  case OPT_INCDAYS:
417    tcl_code = Tol_ListToDate( interp, objv[0], date, obj_result );
418    if ( tcl_code != TCL_OK )
419      return TCL_ERROR;
420    i = 1;
421    if ( objc == 2 ) {
422      tcl_code = Tcl_GetIntFromObj( interp, objv[1], &i );
423      if ( tcl_code != TCL_OK ) {
424        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
425        return TCL_ERROR;
426      }
427    }
428    date.IncDay( i );
429    break;
430  case OPT_INCMONTHS:
431    tcl_code = Tol_ListToDate( interp, objv[0], date, obj_result );
432    if ( tcl_code != TCL_OK )
433      return TCL_ERROR;
434    i = 1;
435    if ( objc == 2 ) {
436      tcl_code = Tcl_GetIntFromObj( interp, objv[1], &i );
437      if ( tcl_code != TCL_OK ) {
438        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
439        return TCL_ERROR;
440      }
441    }
442    date.IncMonth( i );
443  }
444  return Tol_DateToList(date, obj_result );
445}
446
447int Tol_ListToDate( Tcl_Interp * interp, Tcl_Obj * list,
448                    BDate & date, Tcl_Obj * obj_result )
449{
450  int tcl_code;
451  int lst_len;
452  Tcl_Obj ** lst_items;
453
454  tcl_code = Tcl_ListObjGetElements(interp,list,&lst_len,&lst_items);
455  if (tcl_code != TCL_OK) {
456    Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
457    return TCL_ERROR;
458  }
459  if ( lst_len < 1 || lst_len > 6 ) {
460    Tcl_AppendStringsToObj( obj_result, "Invalid date '",
461    Tcl_GetString(list), "' should be a list {Y ?M D h m s?}", NULL );
462    return TCL_ERROR;
463  } else {
464    int arr_date[6] = {0,1,1,0,0};
465    double second = 0.0;
466    int top_int;
467
468    if ( lst_len < 6 )
469      top_int = lst_len;
470    else {
471      top_int = 5;
472      tcl_code = Tcl_GetDoubleFromObj( interp, lst_items[5], &second) ;
473      if ( tcl_code != TCL_OK ) {
474        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
475        return TCL_ERROR;
476      }     
477    }
478    for ( int i = 0; i < top_int; i++ ) {
479      tcl_code = Tcl_GetIntFromObj( interp, lst_items[i], arr_date+i) ;
480      if ( tcl_code != TCL_OK ) {
481        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
482        return TCL_ERROR;
483      }
484    }
485    date.PutDate( arr_date[0], arr_date[1],
486                  arr_date[2], arr_date[3],
487                  arr_date[4], second );
488  }
489  if ( !date.HasValue() ) {
490    Tcl_AppendStringsToObj( obj_result, "Invalid date '",
491                            Tcl_GetString(list), "'", NULL );
492    return TCL_ERROR;
493  }
494  return TCL_OK;
495}
496
497#define IT_YEAR   0
498#define IT_MONTH  1
499#define IT_DAY    2
500#define IT_HOUR   3
501#define IT_MINUTE 4
502#define IT_SECOND 5
503#define IT_SIZE   6
504
505int Tol_DateToList( BDate & date, Tcl_Obj * obj_result )
506{
507  Tcl_Obj * date_items[IT_SIZE];
508
509  date_items[IT_YEAR]   = Tcl_NewIntObj   ( date.Year() );
510  date_items[IT_MONTH]  = Tcl_NewIntObj   ( date.Month() );
511  date_items[IT_DAY]    = Tcl_NewIntObj   ( date.Day() );
512  date_items[IT_HOUR]   = Tcl_NewIntObj   ( date.Hour() );
513  date_items[IT_MINUTE] = Tcl_NewIntObj   ( date.Minute() );
514  date_items[IT_SECOND] = Tcl_NewDoubleObj( date.Second() );
515  Tcl_SetListObj( obj_result, IT_SIZE, date_items );
516  return TCL_OK;
517}
Note: See TracBrowser for help on using the repository browser.