+++ /dev/null
-(* $Id$ *)
-
-(* A small calendar *)
-(* Needs Unix module, so use with lablgtk_t *)
-
-open Printf
-
-type date = { mutable year: int; mutable mon: int; mutable mday: int }
-
- (* Load the schedule data *)
-let calendar_file = Filename.concat (Sys.getenv "HOME") ".camlendar"
-
-let schedule =
- try
- let ichan = open_in calendar_file in
- let (s : (int * int * int, string) Hashtbl.t) =
- Marshal.from_channel ichan in
- close_in ichan;
- s
- with Sys_error msg ->
- prerr_endline msg; flush stderr;
- Hashtbl.create 13;;
-
- (* Saves the schedule data when the application terminates *)
-at_exit (fun () ->
- let ochan = open_out calendar_file in
- Marshal.to_channel ochan schedule ~mode: [];
- close_out ochan);;
-
- (* date: Current date initialized to "today" *)
-let date =
- let tm = Unix.localtime (Unix.time ()) in
- { year = 1900 + tm.Unix.tm_year; mon = tm.Unix.tm_mon; mday = 1 }
-
-
- (* previous_month, next_month: change application status *)
-let previous_month () =
- date.mday <- 1;
- if date.mon = 0 then
- (date.year <- date.year - 1; date.mon <- 11)
- else date.mon <- date.mon - 1
-
-let next_month () =
- date.mday <- 1;
- if date.mon = 11 then (date.year <- date.year + 1; date.mon <- 0)
- else date.mon <- date.mon + 1
-
- (* leap, mon_name, wday_name: Calendar related function and data *)
-let leap year =
- (year mod 400 = 0) or
- (year mod 4 = 0) & (year mod 100 <> 0)
-
-let mdays_in_month = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31|]
-
-let mon_name =
- [|"Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun";
- "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"|]
-
-let wday_name =
- [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|]
-
-let s_normal = 0 and s_focused = 1 and s_planned = 2
-let styles =
- let default = (Obj.magic () : GObj.style) in
- [| default; default; default |]
-
- (* class date_button: one button for each day in the month *)
-class date_button i (calendar : GPack.table) =
- let mday = i + 1 in
-
- object (self)
- val widget = GButton.button ~label: (string_of_int mday) ~show: false ()
- val mday = mday
- val mutable show = false
- val mutable have_plan = false
-
- method widget = widget
- method focus_on =
- date.mday <- mday;
- widget#misc#set_style styles.(s_focused)
- method focus_off =
- widget#misc#set_style styles.(if have_plan then s_planned else s_normal)
- method set_plan =
- have_plan <- true;
- widget#misc#set_style styles.(s_planned)
- method unset_plan =
- have_plan <- false;
- widget#misc#set_style styles.(s_normal)
-
- method show wday0 =
- if not show then
- let top = (mday + wday0) / 7 + 1
- and left = (mday + wday0) mod 7 in
- calendar#attach ~left ~top ~expand:`BOTH widget#coerce;
- widget#misc#show ();
- show <- true
-
- method hide =
- if show then
- (widget#misc#hide ();
- calendar#remove widget#coerce;
- show <- false)
- end
-
-let update_calendar (calendar : GPack.table) (buttons : date_button array) =
- let now = Unix.localtime (Unix.gettimeofday ()) in
- let _, first = Unix.mktime { now with
- Unix.tm_mday = 1;
- Unix.tm_mon = date.mon;
- Unix.tm_year = date.year - 1900 } in
-
- (* wday0: day of the week of the zero'th day in the month *)
- let wday0 = (first.Unix.tm_wday - 1 + 7) mod 7 in
-
- let ndays =
- if date.mon = 1 & leap date.year then mdays_in_month.(date.mon) + 1
- else mdays_in_month.(date.mon) in
-
- Array.iter ~f: (fun button -> button#hide)
- buttons;
-
- for i = 0 to ndays - 1 do buttons.(i)#show wday0 done
-
-let create_GUI () =
-
- (* views part *)
-
- let win =
- GWindow.window ~title: "Camlendar" ~show: true
- ~allow_shrink: false ~allow_grow: false () in
- win#event#connect#delete
- ~callback: (fun _ -> GMain.Main.quit (); exit 0; false);
-
- let style = win#misc#style#copy in
- styles.(s_normal) <- style;
-
- let style = style#copy in
- style#set_bg [`NORMAL, `NAME "light green";
- `PRELIGHT, `NAME "light green"];
- styles.(s_focused) <- style;
-
- styles.(s_focused) <- style;
- let style = style#copy in
- style#set_bg [`NORMAL, `NAME "sky blue";
- `PRELIGHT, `NAME "sky blue"];
- styles.(s_planned) <- style;
-
- let vbox = GPack.vbox ~packing: win#add () in
- let packing = vbox#add in
- let toolbar = GButton.toolbar ~style: `TEXT ~packing () in
-
- let prev =
- toolbar#insert_button ~text: "Prev" ~tooltip: "Show previous month" () in
- let next =
- toolbar#insert_button ~text: "Next" ~tooltip: "Show next month" () in
-
- let calendar =
- GPack.table ~homogeneous: true ~rows: 7 ~columns: 7
- ~border_width: 10 ~row_spacings: 2 ~col_spacings: 2 ~packing () in
-
- Array.iteri
- ~f: (fun i wday ->
- ignore (GButton.button ~label: wday
- ~packing:(calendar#attach ~top: 0 ~left: i ~expand:`BOTH) ()))
- wday_name;
-
- let buttons =
- Array.init 31 ~f: (fun i -> new date_button i calendar) in
-
- let date_view = GMisc.label ~justify: `CENTER ~packing () in
-
- let text = GEdit.text ~editable: true ~width: 70 ~height: 50 ~packing () in
-
- (* Controls part *)
-
- let save_text () =
- let data = text#get_chars ~start: 0 ~stop: text#length in
- let key = (date.year, date.mon, date.mday) in
- Hashtbl.remove schedule key;
- if data <> "" then
- (Hashtbl.add schedule ~key ~data;
- buttons.(date.mday - 1)#set_plan)
- else buttons.(date.mday - 1)#unset_plan in
-
- let restore_text () =
- text#delete_text ~start: 0 ~stop: text#length;
- try
- text#insert_text ~pos: 0
- (Hashtbl.find schedule (date.year, date.mon, date.mday));
- ()
- with Not_found -> () in
-
- let update_date_view () =
- date_view#set_text (sprintf "%d %s, %d\n"
- date.mday mon_name.(date.mon) date.year) in
-
- let update_view () =
- update_calendar calendar buttons;
- update_date_view ();
- Array.iteri ~f: (fun i button ->
- (try
- Hashtbl.find schedule (date.year, date.mon, i + 1);
- button#set_plan
- with Not_found -> button#unset_plan);
- button#focus_off) buttons;
- win#set_title (sprintf "Camlendar: %s, %d"
- mon_name.(date.mon) date.year) in
-
- prev#connect#clicked
- ~callback: (fun () ->
- save_text ();
- previous_month ();
-
- update_view ();
- restore_text ();
- buttons.(0)#focus_on);
-
- next#connect#clicked
- ~callback: (fun () ->
- save_text ();
- next_month ();
-
- update_view ();
- restore_text ();
- buttons.(0)#focus_on);
-
- Array.iteri
- ~f: (fun i button ->
- button#widget#connect#clicked
- ~callback: (fun () ->
- save_text ();
- buttons.(date.mday - 1)#focus_off;
-
- button#focus_on;
- restore_text ();
- update_date_view ());
- ())
- buttons;
-
- update_view ();
- buttons.(0)#focus_on;;
-
-GMain.Main.init ();
-print_endline (GtkMain.Main.set_locale ());
-flush stdout;
-create_GUI ();
-GMain.Main.main ()
projects / helm.git / blobdiff