[Aimmath-commit] AIM/WEB-INF/maple newDate.mpl,NONE,1.1.2.1

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/aimmath/AIM/WEB-INF/maple
In directory sc8-pr-cvs1:/tmp/cvs-serv1454/WEB-INF/maple

Added Files:
      Tag: develop_2_1
	newDate.mpl 
Log Message:
New version of Date.mpl using external calling

--- NEW FILE: newDate.mpl ---
#  @(#)$Id: newDate.mpl,v 1.1.2.1 2003/07/11 15:29:17 npstrick Exp $

# Copyright (C) 2003 Neil Strickland
# Distributed without warranty under the GPL - see README for details

read("Package.mpl"):

Package("Date","
 This package defines various functions for dealing with dates and
 times.
"):

`Package/Dependencies` := ["I18n","Class"]:

######################################################################

`Package/Assign`(
 `type/Date/RawDate`::type,
 "A raw date is just an integer, interpreted as a number of seconds 
  since the beginning of the year 1970 in Greenwich.
 ",
 integer
):

######################################################################

`Package/Assign`(
 `type/Date/ListDate`::type,
 "A list date is a list of six integers, interpreted as a date of the
  form [year,month,day,hour,minute,second].
 ",
 [integer$6]
):

######################################################################

`Package/Assign`(
 `Date/EnglishShortMonthName`::table,
 "A table of short names of the months in English, indexed by 1..12.
  Even if we are working in a different language, these are needed 
  to interpret dates reported by the operating system etc.",
 table([
  1  = "Jan",
  2  = "Feb",
  3  = "Mar",
  4  = "Apr",
  5  = "May",
  6  = "Jun",
  7  = "Jul",
  8  = "Aug",
  9  = "Sep",
  10 = "Oct",
  11 = "Nov",
  12 = "Dec"
 ])):

`Package/Assign`(
 `Date/MonthNumber`::table,
 "A table indexed by the short English names of months, giving their
  numbers; for example
  @`Date/MonthNumber`[\"Oct\"] = 10@.
 ",
 table([])
):

for i from 1 to 12 do
 `Date/MonthNumber`[`Date/EnglishShortMonthName`[i]] := i:
od:

unassign('i'):

`Package/Assign`(
`Date/ShortMonthName`::table,
 "A table of short names of the months in the current locale,
  indexed by 1..12.",
 table([
  1  = __("Jan"),
  2  = __("Feb"),
  3  = __("Mar"),
  4  = __("Apr"),
  5  = __("May"),
  6  = __("Jun"),
  7  = __("Jul"),
  8  = __("Aug"),
  9  = __("Sep"),
  10 = __("Oct"),
  11 = __("Nov"),
  12 = __("Dec")
 ])):

`Package/Assign`(
`Date/MonthName`::table,
 "A table of full names of the months in the current locale,
  indexed by 1..12.",
 table([
  1  = __("January"),
  2  = __("February"),
  3  = __("March"),
  4  = __("April"),
  5  = __("May"),
  6  = __("June"),
  7  = __("July"),
  8  = __("August"),
  9  = __("September"),
  10 = __("October"),
  11 = __("November"),
  12 = __("December")
 ])):

######################################################################

`Package/Assign`(
 `Date/MonthLengths`::list(integer),
 "The list of lengths of months in a non-leap year",
 [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
):

`Package/Assign`(
 `Date/IsLeapYear`::boolean, 
 "Returns @true@ if @year@ is a leap year, and false otherwise.
  Years divisible by 100 are usally not leap years, but the year
  2000 is an exception, and we are unlikely to need any other
  centuries. We therefore use the naive rule.",
 proc(year::integer)
  RETURN(evalb(irem(year,4) = 0));
 end
):

`Package/Assign`(
`Date/MonthLength`::integer,
 "Return the number of days in month @month@ in year @year@.",
 proc(month::integer,year::integer)
  if month = 2 and `Date/IsLeapYear`(year) then
   RETURN(29);
  else
   RETURN(`Date/MonthLengths`[month]);
  fi;
 end
):

`Package/Assign`(
 `Date/ShortDayName`::table,
 "A table of short names of the days of the week in the current locale,
  indexed by 1..7, with 1 corresponding to Monday.
 ",
 table([
  1 = __("Mon"),
  2 = __("Tue"),
  3 = __("Wed"),
  4 = __("Thu"),
  5 = __("Fri"),
  6 = __("Sat"),
  7 = __("Sun")
 ])):

`Package/Assign`(
 `Date/DayName`::table,
 "A table of full names of the days of the week in the current locale,
  indexed by 1..7, with 1 corresponding to Monday.
 ",
 table([
  1 = __("Monday"),
  2 = __("Tuesday"),
  3 = __("Wednesday"),
  4 = __("Thursday"),
  5 = __("Friday"),
  6 = __("Saturday"),
  7 = __("Sunday")
 ])):

`Package/Assign`(
 `Date/CurrentRawDate`::`Date/RawDate`,
 "Return the current raw date.",
 proc()
   iolib(25);
 end
):

if (SearchText("APPLE",interface('version')) > 0) then 
 `Date/CurentRawDate` :=
  proc() 2212118897 + iolib(25); end:
fi:

######################################################################

`Class/Declare`(`Date`,
 "An instance represents a date and time, to an accuracy of one second,
  together with information about which time zone is being used.
 ",
 ['Constructor',
  "If @date_@ is absent, construct the current date.<br>
   If @date_@ is an integer, interpret it as a raw date, and construct
              a corresponding Date object.<br>
   If @date_@ is a list of six integers, interpret them as year, month,
              day, hour, minute and second, and construct a
              corresponding date object.
  ",
  proc(this,date_::{`Date/RawDate`,`Date/ListDate`})
   this['SetTimeZone'];

   if nargs = 1 then 
    this['Raw'] := `Date/CurrentRawDate`(); 
    this['FillFromRaw'];
   else
    if type(date_,integer) then
     this['SetRaw',args[2..-1]];
    elif type(date_,list(integer)) then
     this['SetCooked',args[2..-1]];
    fi;
   fi;
  end
 ],

 ['Field','Raw'::`Date/RawDate` = 0,
  "The number of seconds since 1st January 1970 00:00:00 UTC"
 ],

 ['Field',
  'TimeZoneName'::string = "UTC",
  "This field is not used in this version of Date.mpl, and should 
   eventually be removed.
  "
 ],

 ['Field','TimeZoneOffset'::integer = 0,
  "Number of seconds ahead of UTC.  
   This field is not used in this version of Date.mpl, and should 
   eventually be removed.
  "
 ],

 ['Field','Summer'::boolean = false,
  "True if summer time is in effect at this date.
   This field is not used in this version of Date.mpl, and should 
   eventually be removed. 
  "
 ],

 ['Field','Year'::integer,
  "The number of the year"
 ],

 ['Field','Month'::integer,
  "The number of the month (starting with January = 1)"
 ],

 ['Field','Day'::integer,
  "The number of the day within the month"
 ],

 ['Field','WeekDay'::integer,
  "The number of the day within the week (starting with Monday = 1)"
 ],

 ['Field','Hour'::integer],
 ['Field','Minute'::integer],
 ['Field','Second'::integer],

 ['Method','SetTimeZone'::'void',
  "This method is not used in this version of Date.mpl, and should 
   eventually be removed.
  ",
  proc() end
 ],

 ['Method','SetRaw'::'void',
  "Set the @Raw@ field to @raw@, and set all other fields accordingly",
  proc(this,raw::`Date/RawDate`)
   this['Raw'] := raw;
   this['FillFromRaw'];
  end
 ],

 ['Method','FillFromRaw'::'void',
  "Set all other fields from the @Raw@ and @TimeZoneOffset@ fields",
  proc(this)
   local a;
   a := Array(0..6, datatype=integer[2], order=C_order);
   cookdate(this['Raw'],a);

   this['Year']      := a[0];
   this['Month']     := a[1];
   this['Day']       := a[2];
   this['WeekDay']   := a[3];
   this['Hour']      := a[4];
   this['Minute']    := a[5];
   this['Second']    := a[6];
   NULL;
  end
 ],

 ['Method','Cooked'::`Date/ListDate`,
  "Return the @[Year,Month,Day,Hour,Minute,Second]@ list
   corresponding to this date",
  proc(this)
   [this['Year'],
    this['Month'],
    this['Day'],
    this['Hour'],
    this['Minute'],
    this['Second']];
  end
 ],

 ['Method','SetCooked'::'void',
  "Set @[Year,Month,Day,Hour,Minute,Second]@ to @ymdhms@, then
   set the @Raw@ field accordingly",
  proc(this,ymdhms::`Date/ListDate`)
   this['Year']    := ymdhms[1];
   this['Month']   := ymdhms[2];
   this['Day']     := ymdhms[3];
   this['Hour']    := ymdhms[4];
   this['Minute']  := ymdhms[5];
   this['Second']  := ymdhms[6];

   this['FillFromCooked'];
  end
 ],

 ['Method','FillFromCooked'::'void',
  "Set the @Raw@ field from the other fields",
  proc(this)
   local a;
   a := Array(0..6, datatype=integer[2], order=C_order);

   a[0] := this['Year'];
   a[1] := this['Month'];
   a[2] := this['Day'];
   a[3] := this['DayOfWeek'];
   a[4] := this['Hour'];
   a[5] := this['Minute'];
   a[6] := this['Second'];

   this['Raw'] := uncookdate(a);
  end
 ],

 ['Method','MonthName'::string,
  "The full name of the month, in the language of the current locale",
  proc(this)
   `Date/MonthName`[this['Month']];
  end
 ],

 ['Method','ShortMonthName'::string,
  "The short name of the month, in the language of the current locale",
  proc(this)
   `Date/ShortMonthName`[this['Month']];
  end
 ],

 ['Method','WeekDayName'::string,
  "The name of the day of the week",
  proc(this)
   `Date/DayName`[this['WeekDay']];
  end
 ],

 ['Method','ShortWeekDayName'::string,
  "The short name of the day of the week",
  proc(this)
   `Date/ShortDayName`[this['WeekDay']];
  end
 ],

 ['Method','DateString'::string,
  "A string describing the date (without the time) in the language of
   the current locale.",
  proc(this)
   sprintf("%A %A %A",
           this['Day'],
           this['ShortMonthName'],
           this['Year']);
  end
 ],

 ['Method','TimeDateString'::string,
  "A string describing the date and time in the language of
   the current locale.",
  proc(this)
   sprintf("%02d:%02d:%02d %d %s %04d",
           this['Hour'],
           this['Minute'],
           this['Second'],
           this['Day'],
           this['ShortMonthName'],
           this['Year']);
  end
 ],

 ['Method','IsPast'::boolean,
  "Returns @true@ if the invoking date has passed",
  proc(this)
   evalb(`Date/CurrentRawDate`() >= this['Raw']);
  end
 ],

 ['Method','IsValid'::boolean,
  "Return @true@ if the month, day, hour, minute and second fields
   lie in the right ranges.
  ",
  proc(this)
   evalb(
    this['Month']  >= 1  and
    this['Month']  <= 12 and
    this['Day']    >= 1  and
    this['Day']    <= `Date/MonthLength`(this['Month'],this['Year']) and
    this['Hour']   >= 0  and
    this['Hour']   <  24 and
    this['Minute'] >= 0  and
    this['Minute'] <  60 and
    this['Second'] >= 0  and
    this['Second'] <  60
   );
  end
 ]
):

`Package/Assign`(
 `Date/CurrentDate`::Date,
 "Return the current date",
 `new/Date`
):

######################################################################

`Package/Assign`(
 `Date/Before`::boolean,
 "Return @true@ if @d1@ is before or equal to @d2@", 
 proc(d1::Date,d2::Date)
  evalb(d1['Raw'] <= d2['Raw']);
 end
):

######################################################################

`Package/Assign`(
`Date/Equal`::boolean,
 "Return @true@ if @d1@ is equal to @d2@", 
 proc(d1::Date,d2::Date)
  evalb(d1['Raw'] = d2['Raw']);
 end
):

######################################################################

`Package/Assign`(
 `Date/Selector/JScript`::string,
 "Text of a JavaScript function for use in a date selection widget",
 "
  function MaybeClearDate(f,n,t) {
   e = document.forms[f].elements[n + t];
   dayelt   = document.forms[f].elements[n + 'Day'];
   monthelt = document.forms[f].elements[n + 'Month'];
   yearelt  = document.forms[f].elements[n + 'Year'];

   if (e.selectedIndex == 0) {
    dayelt.selectedIndex = 0;
    monthelt.selectedIndex = 0;
    yearelt.selectedIndex = 0;
   } else {
    if (dayelt.selectedIndex == 0) {
     dayelt.selectedIndex = 1;
    }
    if (monthelt.selectedIndex == 0) {
     monthelt.selectedIndex = 1;
    }
    if (yearelt.selectedIndex == 0) {
     yearelt.selectedIndex = 1;
    }
   }
  };

  function MaybeClearFullDate(f,n,t) {
   e = document.forms[f].elements[n + t];
   minelt   = document.forms[f].elements[n + 'Minute'];
   hourelt  = document.forms[f].elements[n + 'Hour'];
   dayelt   = document.forms[f].elements[n + 'Day'];
   monthelt = document.forms[f].elements[n + 'Month'];
   yearelt  = document.forms[f].elements[n + 'Year'];

   if (e.selectedIndex == 0) {
    minelt.selectedIndex = 0;
    hourelt.selectedIndex = 0;
    dayelt.selectedIndex = 0;
    monthelt.selectedIndex = 0;
    yearelt.selectedIndex = 0;
   } else {
    if (minelt.selectedIndex == 0) {
     minelt.selectedIndex = 1;
    }
    if (hourelt.selectedIndex == 0) {
     hourelt.selectedIndex = 1;
    }
    if (dayelt.selectedIndex == 0) {
     dayelt.selectedIndex = 1;
    }
    if (monthelt.selectedIndex == 0) {
     monthelt.selectedIndex = 1;
    }
    if (yearelt.selectedIndex == 0) {
     yearelt.selectedIndex = 1;
    }
   }
  };
"
):

##################################################

`Package/Assign`(
 `Date/Selector`::`HTML/String`,
 "Return HTML text including input elements for selecting a date.
  @form@ is the name of the form that will contain these elements.
  @nam@ is used as a prefix for the names of the input elements;
  the suffices @\"Day\"@, @\"Month\"@, and @\"Year\"@ will be
  appended.  @startyear@ and @endyear@ specify the range of years
  to be selected from.  The optional argument @initial_@ specifies
  an initial selection.
  <br><br>
  No input fields are provided for the hour, minute and second.
 ",
 proc(form::string,
      nam::string,
      startyear::integer,
      endyear::integer,
      # optional
      initial_::Date)

  local initialday,initialmonth,initialyear;

  if nargs > 4 then
   initialday   := sprintf("%A",initial_['Day']);
   initialmonth := sprintf("%A",initial_['Month']);
   initialyear  := sprintf("%A",initial_['Year']);
  else
   initialday   := "0";
   initialmonth := "0";
   initialyear  := "0";
  fi;

  `new/HTML/Tag`(
   "table",
    ["tr",
     ["td",__("Day:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Day"),
	  "selection" = initialday,
	  "onchange" =
	   sprintf("MaybeClearDate('%s','%s','Day')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     sprintf("%A",i)],
	    i = 1..31)]],
     ["td",__("Month:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Month"),
	  "selection" = initialmonth,
	  "onchange" = 
	   sprintf("MaybeClearDate('%s','%s','Month')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     `Date/ShortMonthName`[i]],
	    i = 1..12)]],
     ["td",__("Year:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Year"),
	  "selection" = initialyear,
	  "onchange" = 
	   sprintf("MaybeClearDate('%s','%s','Year')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     sprintf("%A",i)],
	    i = startyear..endyear)]]]);
 end
):

##################################################

`Package/Assign`(
 `Date/FullSelector`::`HTML/String`,
 "Return HTML text including input elements for selecting a date.
  @form@ is the name of the form that will contain these elements.
  @nam@ is used as a prefix for the names of the input elements;
  the suffices @\"Hour\"@, @\"Minute\"@, @\"Day\"@,
  @\"Month\"@, and @\"Year\"@ will be appended.  @startyear@ and
  @endyear@ specify the range of years to be selected from.  The
  optional argument @initial_@ specifies an initial selection.
 ",
 proc(form::string,
      nam::string,
      startyear::integer,
      endyear::integer,
      # optional
      initial_::Date)

  local initialday,initialmonth,initialyear,
        initialhour,initialminute;

  if nargs > 4 then
   initialhour   :=
    sprintf("%A",initial_['Hour']+1);
   initialminute :=
    sprintf("%A",round(initial_['Minute']/5)+1);
   initialday    := sprintf("%A",initial_['Day']);
   initialmonth  := sprintf("%A",initial_['Month']);
   initialyear   := sprintf("%A",initial_['Year']);
  else
   initialhour   := "0";
   initialminute := "0";
   initialday    := "0";
   initialmonth  := "0";
   initialyear   := "0";
  fi;

  `new/HTML/Tag`(
   "table",
    ["tr",
     ["td",__("Hour:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Hour"),
	  "selection" = initialhour,
	  "onchange" =
	   sprintf("MaybeClearFullDate('%s','%s','Hour')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     sprintf("%A",i-1)],
	    i = 1..24)]],
     ["td",__("Minute:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Minute"),
	  "selection" = initialminute,
	  "onchange" =
	   sprintf("MaybeClearFullDate('%s','%s','Minute')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     sprintf("%A",5*(i-1))],
	    i = 1..12)]],
     ["td",__("Day:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Day"),
	  "selection" = initialday,
	  "onchange" =
	   sprintf("MaybeClearFullDate('%s','%s','Day')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     sprintf("%A",i)],
	    i = 1..31)]],
     ["td",__("Month:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Month"),
	  "selection" = initialmonth,
	  "onchange" = 
	   sprintf("MaybeClearFullDate('%s','%s','Month')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     `Date/ShortMonthName`[i]],
	    i = 1..12)]],
     ["td",__("Year:")],
      ["td",
       [["select",
	  "name" = cat(nam,"Year"),
	  "selection" = initialyear,
	  "onchange" = 
	   sprintf("MaybeClearFullDate('%s','%s','Year')",form,nam)],
	[["option", "value" = "0"],__("none")],
	seq([["option", "value" = sprintf("%A",i)],
	     sprintf("%A",i)],
	    i = startyear..endyear)]]]);
 end
):

##################################################

`Package/Assign`(
 `Date/GetSelection`,
 "This function is used to extract a date that has been selected using
  form elements as produced by the function #`Date/Selector`#.  The
  argument @nam@ is the name prefix supplied to that function, and
  @p@ is the CGI parameter table.  Thus, if @nam = \"Foo\"@ then
  the date is obtained from the entries @p[\"FooYear\"]@, 
  @p[\"FooMonth\"]@ and @p[\"FooDay\"]@.  There are no fields for the
  hour, minute or second; instead, the date returned is always 
  23:59:59 at the end of the specified day.  @NULL@ is returned if
  there is any kind of failure.
 ",
 proc(p::table,nam::string)
  local conv,year,month,day,date;

  conv :=
   proc(x)
    local y;
    if not(type(x,string)) then RETURN(NULL); fi;
    y := traperror(sscanf(x,"%d")[1]);
    if type(y,integer) then RETURN(y) else RETURN(NULL); fi;
   end;

  year  := conv(p[cat(nam,"Year")]);
  month := conv(p[cat(nam,"Month")]);
  day   := conv(p[cat(nam,"Day")]);

  if (year = NULL or month = NULL or day = NULL) then 
   RETURN(NULL);
  fi;

  date := traperror(`new/Date`([year,month,day,23,59,59]));
  if not(type(date,Date)) then date := NULL; fi;

  RETURN(eval(date));
 end
):

##################################################

`Package/Assign`(
 `Date/GetFullSelection`,
 "This function is used to extract a date that has been selected using
  form elements as produced by the function #`Date/FullSelector`#.  The
  argument @nam@ is the name prefix supplied to that function, and
  @p@ is the CGI parameter table.  Thus, if @nam = \"Foo\"@ then
  the date is obtained from the entries @p[\"FooYear\"]@, 
  @p[\"FooMonth\"]@, @p[\"FooDay\"]@, @p[\"FooHour\"]@ and
  @p[\"FooMinute\"]@.   @NULL@ is returned if there is any kind of
  failure.
 ",
 proc(p::table,nam::string)
  local conv,year,month,day,hour,minute,date;

  conv :=
   proc(x)
    local y;
    if not(type(x,string)) then RETURN(NULL); fi;
    y := traperror(sscanf(x,"%d")[1]);
    if type(y,integer) then RETURN(y) else RETURN(NULL); fi;
   end;

  if p[cat(Nam,"Hour")] = "0" then
   RETURN(NULL);
  else
   hour := conv(p[cat(nam,"Hour")]) - 1;
  fi;

  if p[cat(Nam,"Minute")] = "0" then
   RETURN(NULL);
  else
   minute := (conv(p[cat(nam,"Minute")]) - 1) * 5;
  fi;

  year  := conv(p[cat(nam,"Year")]);
  month := conv(p[cat(nam,"Month")]);
  day   := conv(p[cat(nam,"Day")]);

  if (year = NULL or month = NULL or day = NULL or
      hour = NULL or minute = NULL) then 
   RETURN(NULL);
  fi;

  date :=
   traperror(`new/Date`([year,month,day,hour,minute,0]));
  if not(type(date,Date)) then date := NULL; fi;

  RETURN(eval(date));
 end
):

######################################################################

EndPackage():