source: tol/toltcl/generic/toltime.cpp @ b6e5dacc

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

refs #1812, refs #1818, compilación basada en CMake, eliminación de warnings, automatización de la regla install.

Configuración en Linux como:

cmake -DCMAKE_TOOLCHAIN_FILE=../linux-i686.toolchain.cmake -DTOL_PREFIX_PATH=/usr/local/tol32 -DCMAKE_BUILD_TYPE=Release -DTCL_LIBRARY=/usr/local/tcl8.5-i686/lib/libtcl8.5.so ..

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@6456 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 14.7 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  int Contain( BDate & d ) { return uts->Contain( d ); }
90};
91
92static
93int Tol_TMSInstanceProc _ANSI_ARGS_((ClientData clientData,
94                                    Tcl_Interp *interp,
95                                    int objc, Tcl_Obj *CONST objv[]));
96
97static
98void Tol_TMSDelInstanceProc _ANSI_ARGS_((ClientData clientData));
99
100/*
101 *  Create a new command to access the given TOL timeset object name.
102 *
103 */
104
105int Tol_CreateTMSCmd( Tcl_Interp * interp, Tcl_Obj * tmscmd,
106                      Tcl_Obj * tmsname, Tcl_Obj * obj_result )
107{
108  const BSyntaxObject * tol_obj;
109  BUserTimeSet * uts;
110  Tcl_CmdInfo cmd_info;
111  char * str_tmscmd = Tcl_GetString(tmscmd);
112 
113  if (!*str_tmscmd) {
114    Tcl_AppendStringsToObj(obj_result,
115                           "invalid timeset command name: must be not empty",
116                           NULL);
117    return TCL_ERROR;
118  }
119 
120  /* verify if tmscmd already exists as a command */
121 
122  if (Tcl_GetCommandInfo(interp,str_tmscmd,&cmd_info) &&
123    (cmd_info.objProc == Tol_TMSInstanceProc)) {
124    Tcl_AppendStringsToObj(obj_result, "\"",str_tmscmd,"\"",
125                           "already exists as timeset command",NULL);
126    return TCL_ERROR;
127  }
128
129  /* now look for tms in tol */
130
131  BGrammar * gra = GraTimeSet();
132
133  if ( !gra ) {
134    Tcl_AppendStringsToObj( obj_result,
135                            "TimeSet grammar not found", NULL );
136    return TCL_ERROR;
137  }
138
[c14b554]139  if (!(tol_obj=Tol_ResolveObject(interp, tmsname, obj_result/*, gra*/))) {
[6d7779d]140    return TCL_ERROR;
141  }
142
143  uts = (BUserTimeSet *)tol_obj;
144
145  TMS_ClientData *clientData = (TMS_ClientData*)Tcl_Alloc(sizeof(TMS_ClientData));
146
147  if (!clientData)
148    return TCL_ERROR;
149
150  clientData->Init(uts);
151  clientData->cmd_token = Tcl_CreateObjCommand( interp,
152                                                str_tmscmd,
153                                                &Tol_TMSInstanceProc,
154                                                (ClientData)clientData,
155                                                &Tol_TMSDelInstanceProc );
156 
157  return TCL_OK;
158}
159
160/*
161 * Destroy the tcl tms commands given in objv.
162 *
163 */
164
165int Tol_DestroyTMSCmd( Tcl_Interp * interp,
166                       int objc, Tcl_Obj *CONST objv[],
167                       Tcl_Obj * obj_result )
168{
169  Tcl_CmdInfo cmd_info;
170  char * cmdname;
171 
172  for (int i=0; i<objc; ++i) {
173    cmdname = Tcl_GetString(objv[i]);
174    if ( Tcl_GetCommandInfo(interp,cmdname,&cmd_info) &&
175         (cmd_info.objProc == Tol_TMSInstanceProc) ) {
176      if (Tcl_DeleteCommand(interp,cmdname) == -1) {
177        Tcl_AppendStringsToObj( obj_result,
178                                "could not delete \"",cmdname,"\"",NULL);
179        return TCL_ERROR;
180      }
181    } else {
182      Tcl_AppendStringsToObj( obj_result,
183                              "can't find timeset command \"",
184                              cmdname,"\"",NULL);
185      return TCL_ERROR;
186    }
187  }
188
189  return TCL_OK;
190}
191
192int Tol_TMSInstanceProc( ClientData clientData,
193                         Tcl_Interp *interp,
194                         int objc, Tcl_Obj *CONST objv[])
195{
196  char * cmd_name = Tcl_GetString( objv[0] );
197
198  if ( objc < 2 || objc > 3 ) {
199    Tcl_AppendResult( interp, "wrong # args: should be\n",
200                      cmd_name, " contain date\n",
201                      cmd_name, " start date\n",
202                      cmd_name, " get\n",
203                      cmd_name, " next\n",
204                      cmd_name, " previous",
205                      NULL );
206    return TCL_ERROR;
207  }
208
209  char * option = Tcl_GetString( objv[1] );
210  int len = strlen( option );
211  TMS_ClientData * tmsData = (TMS_ClientData *)clientData;
212  int tcl_code = TCL_OK;
213  BDate dte;
214
215  if ( !strncmp( "contain", option, len ) ) {
216    if ( objc != 3 ) {
217      Tcl_AppendResult( interp, "wrong # args: should be, ",
218                        cmd_name, " contain date", NULL );
219      tcl_code = TCL_ERROR;
220    } else {
221      tcl_code = Tol_ListToDate( interp, objv[2], dte,
222                                 Tcl_GetObjResult(interp) );
223      if ( tcl_code == TCL_OK )
224        Tcl_SetIntObj( Tcl_GetObjResult(interp),
225                       tmsData->Contain( dte ) );
226    }
227    return tcl_code;
228  } else if ( !strncmp( "start", option, len ) ) {
229    if ( objc != 3 ) {
230      Tcl_AppendResult( interp, "wrong # args: should be, ",
231                        cmd_name, " start date", NULL );
232      tcl_code = TCL_ERROR;
233    } else {
234      tcl_code = Tol_ListToDate( interp, objv[2], dte,
235                                 Tcl_GetObjResult(interp) );
236      if ( tcl_code == TCL_OK )
237        tmsData->Start( dte );
238    }
239  } else {
240    if ( objc != 2 ) {
241      Tcl_AppendResult( interp, "wrong # args: should be, ",
242                        cmd_name, " get\n",
243                        cmd_name, " next\n",
244                        cmd_name, " previous", NULL );
245      tcl_code = TCL_ERROR;
246    } else if ( !strncmp( "next", option, len ) ) {
247      tmsData->Next();
248    } else if ( !strncmp( "previous", option, len ) ) {
249      tmsData->Previous();
250    } else if ( strncmp( "get", option, len ) ) {
251      Tcl_AppendResult( interp, "invalid option '",
252                        option,
253                        "', should be: start, get, next or previous", NULL );
254      tcl_code = TCL_ERROR;
255    }
256  }
257
258  if ( tcl_code != TCL_ERROR ) {
259    if ( tmsData->HasValue() )
260      tcl_code = Tol_DateToList( tmsData->Get(), Tcl_GetObjResult(interp) );
261    else
262      Tcl_SetResult( interp, "-1 -1 -1 -1 -1 -1", TCL_VOLATILE );
263  }
264  return tcl_code;
265}
266
267void Tol_TMSDelInstanceProc( ClientData clientData )
268{
269   TMS_ClientData * tmsData = (TMS_ClientData*)clientData;
270
271   if ( tmsData )
272      tmsData->Destroy();
273}
274
275
276/*
277 *  Implement tol::date
278 *
279 *       tol::date first              -> default first date
280 *       tol::date last               -> default last  date
281 *       tol::date now     ?fmt?       -> today date/time
282 *       tol::date weekday date        -> 0(sunday), 1(monday), ..., 6(saturday)
283 *       tol::date nod     year month  -> number of days of month/year
284 *       tol::date +day    date ?n?    -> date ++ ?n days?
285 *       tol::date +month  date ?n?    -> date ++ ?n months?
286 *
287 *  Results:
288 *       a valid date
289 *
290 *       date is always a list {Y M D h m s}
291 *
292 */
293
294int Tol_DateOption( Tcl_Interp * interp,
295                    int objc, Tcl_Obj *CONST objv[],
296                    Tcl_Obj * obj_result )
297{
298  char * cmd = Tcl_GetString( objv[0] );
299  if ( objc < 2 || objc > 4 ) {
300    Tcl_AppendStringsToObj( obj_result, "wrong # args, should be:\n",
301                            cmd, " first\n",
302                            cmd, " last\n",
303                            cmd, " now ?fmt?\n",
304                            cmd, " weekday date\n",
305                            cmd, " days year month\n",
306                            cmd, " +day date ?n?\n",
307                            cmd, " +month date ?n?\n", NULL );
308    return TCL_ERROR;
309  }
310
311  char * option = Tcl_GetString( objv[1] );
312  int len = strlen( option );
313  int tcl_code = TCL_OK;
314  int opt_code;
315  int min_args;
316  int max_args;
317
318#define OPT_UNKNOWN   -1
319#define OPT_FIRST     0
320#define OPT_LAST      1
321#define OPT_NOW       2
322#define OPT_WEEKDAY   3
323#define OPT_DAYS      4
324#define OPT_INCDAYS   5
325#define OPT_INCMONTHS 6
326
327  objc -= 2;
328  objv += 2;
329  opt_code = OPT_UNKNOWN;
330  min_args = 0;
331  max_args = 0;
332
333  if ( !strncmp( "first", option, len ) )
334    opt_code = OPT_FIRST;
335  else if ( !strncmp( "last", option, len ) )
336    opt_code = OPT_LAST;
337  else if ( !strncmp( "now", option, len ) ) {
338    opt_code = OPT_NOW;
339    min_args = 0; max_args = 1;
340  } else if ( !strncmp( "weekday", option, len ) ) {
341    opt_code = OPT_WEEKDAY;
342    min_args = max_args = 1;
343  } else if ( !strncmp( "days", option, len ) ) {
344    opt_code = OPT_DAYS;
345    min_args = max_args = 2;
346  } else if ( !strncmp( "+day", option, len ) ) {
347    opt_code = OPT_INCDAYS;
348    min_args = 1;
349    max_args = 2;
350  } else if ( !strncmp( "+month", option, len ) ) {
351    opt_code = OPT_INCMONTHS;
352    min_args = 1;
353    max_args = 2;
354  } else {
355    Tcl_AppendStringsToObj( obj_result,
356      "invalid option, should be: first, last, now, weekday, days, +day or +month",
357      NULL );
358    return TCL_ERROR;
359  }
360
361  if ( objc < min_args || objc > max_args ) {
362    Tcl_AppendStringsToObj( obj_result,
363      "wrong # args calling '", cmd, " ", option, "'", NULL );
364    return TCL_ERROR;
365  }
366
367  BDate date;
368  int YM[2], i;
369
370  switch ( opt_code ) {
371  case OPT_FIRST:
372    date = BDate::DefaultFirst();
373    break;
374  case OPT_LAST:
375    date = BDate::DefaultLast();
376    break;
377  case OPT_NOW:
378    date = DteNow();
379    if (objc == 1) {
380      char * fmt = Tcl_GetString( objv[0] );
381      if ( *fmt ) {
382        BDateFormat bformat( fmt );
383        BText dfmt( bformat.DateToText(date) );
384        Tcl_AppendStringsToObj( obj_result, dfmt.Buffer(), NULL );
385        return TCL_OK;
386      }
387    }
388    break;
389  case OPT_WEEKDAY:
390    tcl_code = Tol_ListToDate( interp, objv[0], date, obj_result );
391    if ( tcl_code != TCL_OK )
392      return TCL_ERROR;
393    Tcl_SetIntObj( obj_result, date.WeekDay() % 7 );
394    return TCL_OK;
395  case OPT_DAYS:
396    for ( i = 0; i < 2; i++ ) {
397      tcl_code = Tcl_GetIntFromObj( interp, objv[i], YM+i );
398      if ( tcl_code != TCL_OK ) {
399        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
400        return TCL_ERROR;
401      }
402    }
403    date.PutDate( YM[0], YM[1] );
404    if ( !date.HasValue() ) {
405      Tcl_AppendStringsToObj( obj_result, "Invalid month '",
406        Tcl_GetString(objv[0]), "-", Tcl_GetString(objv[1]),
407        "'", NULL );
408      return TCL_ERROR;
409    }
410    Tcl_SetIntObj( obj_result, DteDaysInMonth( YM[1], YM[0] ) );
411    return TCL_OK;
412  case OPT_INCDAYS:
413    tcl_code = Tol_ListToDate( interp, objv[0], date, obj_result );
414    if ( tcl_code != TCL_OK )
415      return TCL_ERROR;
416    i = 1;
417    if ( objc == 2 ) {
418      tcl_code = Tcl_GetIntFromObj( interp, objv[1], &i );
419      if ( tcl_code != TCL_OK ) {
420        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
421        return TCL_ERROR;
422      }
423    }
424    date.IncDay( i );
425    break;
426  case OPT_INCMONTHS:
427    tcl_code = Tol_ListToDate( interp, objv[0], date, obj_result );
428    if ( tcl_code != TCL_OK )
429      return TCL_ERROR;
430    i = 1;
431    if ( objc == 2 ) {
432      tcl_code = Tcl_GetIntFromObj( interp, objv[1], &i );
433      if ( tcl_code != TCL_OK ) {
434        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
435        return TCL_ERROR;
436      }
437    }
438    date.IncMonth( i );
439  }
440  return Tol_DateToList(date, obj_result );
441}
442
443int Tol_ListToDate( Tcl_Interp * interp, Tcl_Obj * list,
444                    BDate & date, Tcl_Obj * obj_result )
445{
446  int tcl_code;
447  int lst_len;
448  Tcl_Obj ** lst_items;
449
450  tcl_code = Tcl_ListObjGetElements(interp,list,&lst_len,&lst_items);
451  if (tcl_code != TCL_OK) {
452    Tcl_AppendObjToObj(obj_result,Tcl_GetObjResult(interp));
453    return TCL_ERROR;
454  }
455  if ( lst_len < 1 || lst_len > 6 ) {
456    Tcl_AppendStringsToObj( obj_result, "Invalid date '",
457    Tcl_GetString(list), "' should be a list {Y ?M D h m s?}", NULL );
458    return TCL_ERROR;
459  } else {
460    int arr_date[6] = {0,1,1,0,0};
461    double second = 0.0;
462    int top_int;
463
464    if ( lst_len < 6 )
465      top_int = lst_len;
466    else {
467      top_int = 5;
468      tcl_code = Tcl_GetDoubleFromObj( interp, lst_items[5], &second) ;
469      if ( tcl_code != TCL_OK ) {
470        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
471        return TCL_ERROR;
472      }     
473    }
474    for ( int i = 0; i < top_int; i++ ) {
475      tcl_code = Tcl_GetIntFromObj( interp, lst_items[i], arr_date+i) ;
476      if ( tcl_code != TCL_OK ) {
477        Tcl_AppendObjToObj( obj_result, Tcl_GetObjResult(interp) );
478        return TCL_ERROR;
479      }
480    }
481    date.PutDate( arr_date[0], arr_date[1],
482                  arr_date[2], arr_date[3],
483                  arr_date[4], second );
484  }
485  if ( !date.HasValue() ) {
486    Tcl_AppendStringsToObj( obj_result, "Invalid date '",
487                            Tcl_GetString(list), "'", NULL );
488    return TCL_ERROR;
489  }
490  return TCL_OK;
491}
492
493#define IT_YEAR   0
494#define IT_MONTH  1
495#define IT_DAY    2
496#define IT_HOUR   3
497#define IT_MINUTE 4
498#define IT_SECOND 5
499#define IT_SIZE   6
500
501int Tol_DateToList( BDate & date, Tcl_Obj * obj_result )
502{
503  Tcl_Obj * date_items[IT_SIZE];
504
505  date_items[IT_YEAR]   = Tcl_NewIntObj   ( date.Year() );
506  date_items[IT_MONTH]  = Tcl_NewIntObj   ( date.Month() );
507  date_items[IT_DAY]    = Tcl_NewIntObj   ( date.Day() );
508  date_items[IT_HOUR]   = Tcl_NewIntObj   ( date.Hour() );
509  date_items[IT_MINUTE] = Tcl_NewIntObj   ( date.Minute() );
510  date_items[IT_SECOND] = Tcl_NewDoubleObj( date.Second() );
511  Tcl_SetListObj( obj_result, IT_SIZE, date_items );
512  return TCL_OK;
513}
Note: See TracBrowser for help on using the repository browser.