(* * <COPYRIGHT> * Copyright 2003 Gerd Stolpmann * * <GPL> * This file is part of WTimer. * * WTimer is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * WTimer is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with WDialog; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * </> *) (* $Id: timetravel.ml,v 1.5 2003/03/23 11:59:14 gerd Exp $ * ---------------------------------------------------------------------- * *) open Wd_dialog open Wd_run_cgi open Wd_types open Db_types.Types open Db_types open Definitions class timetravel db universe name env = object (self) inherit dialog universe name env inherit error_behaviour method private check_auth () = check_auth db (self # dialog_variable "session") method private add_message m = let msgs = self # enum_variable "message" in self # set_variable "message" (Enum_value(m :: msgs)); method private try_prepare_page() = () method private try_handle() = (* Before anything else happens, parse the input boxes: *) self # set_variable "message" (Enum_value []); let entered_year = self # string_variable "entered_year" in ( try let year = int_of_string entered_year in if year < 1902 || year > 2037 then failwith "Year out of range"; self # set_variable "year" (String_value(string_of_int year)); with Failure _ -> self # add_message "error-bad-year"; raise(Change_page self#page_name); ); (* Check whether a file menu button has been pressed: *) try raise(Change_dialog(Filemenu.handle (self :> dialog_type) db self#event)) with Filemenu.Not_competent -> (* No: Perhaps a timewarp *) ( match self#event with Indexed_button("calendary-month",new_date) -> let session = self # dialog_variable "session" in self # set_variable "session.current-date" (String_value new_date); let next_dlg = !Registry.new_editor universe env session in raise(Change_dialog next_dlg) | Button "cont-error" -> self # set_next_page "calendary" | _ -> () ) end ;; Registry.new_timetravel := fun universe env opt_session -> let dlg = universe # create env "timetravel" in dlg # set_variable "session" (Dialog_value opt_session); ( match opt_session with Some session -> let date = Date.from_string (session # string_variable "current-date") in let year = String_value(string_of_int((Date.access date).year)) in dlg # set_variable "year" year; dlg # set_variable "entered_year" year; | None -> () ); dlg ;; (* ====================================================================== * History: * * $Log: timetravel.ml,v $ * Revision 1.5 2003/03/23 11:59:14 gerd * GPL * * Revision 1.4 2003/02/03 01:28:59 gerd * Continued. * * Revision 1.3 2003/01/26 23:45:16 gerd * Improved error behaviour. * * Revision 1.2 2003/01/16 00:39:25 gerd * Continued. * * Revision 1.1 2002/11/16 12:34:51 gerd * Initial revision * * *)