File: remind.ml

package info (click to toggle)
wyrd 1.4.6-4
  • links: PTS
  • area: main
  • in suites: stretch
  • size: 1,820 kB
  • ctags: 1,969
  • sloc: ml: 11,059; sh: 5,531; ansic: 760; makefile: 304; python: 44
file content (821 lines) | stat: -rw-r--r-- 33,517 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
(*  Wyrd -- a curses-based front-end for Remind
 *  Copyright (C) 2005, 2006, 2007, 2008, 2010, 2011-2013 Paul Pelzl
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License, Version 2,
 *  as published by the Free Software Foundation.
 *
 *  This program 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 this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 *  Bug reports can be entered at http://bugs.launchpad.net/wyrd .
 *  For anything else, feel free to contact Paul Pelzl at <pelzlpj@gmail.com>.
 *)

(* remind.ml
 * functions for interfacing with 'remind(1)' *)


exception Occurrence_not_found

open Utility


(* Define a Set that takes pairs of integers as keys. *)
module IntPair =
   struct
      type t = int * int
      let compare i j = Pervasives.compare i j
   end
module IPSet = Set.Make (IntPair)


(* A record for an individual timed reminder, as read from
 * the output of 'remind -s'. *)
type timed_rem_t = {
   tr_start      : float;
   tr_end        : float;
   tr_msg        : string;
   tr_filename   : string;
   tr_linenum    : string;
   tr_has_weight : bool
}


(* A record for an individual untimed reminder, as read from
 * the output of 'remind -s'. *)
type untimed_rem_t = {
   ur_start      : float;
   ur_msg        : string;
   ur_filename   : string;
   ur_linenum    : string;
   ur_has_weight : bool
}


(* Storage for a three-month window of reminders and
 * the calendar for the current month.
 * Makes it possible to handle edge effects of moving
 * from month to month without constantly calling 
 * rem(1) and regenerating calendar layouts. 
 *
 * Timed reminders are stored in an array of lists,
 * with each element of the array representing a different
 * indentation level on the timetable.  Untimed reminders
 * have no indentation, so they are simply stored in
 * lists. *)
type three_month_rem_t = {
   curr_timestamp : float;
   prev_timed     : timed_rem_t list array;
   curr_timed     : timed_rem_t list array;
   next_timed     : timed_rem_t list array;
   all_timed      : timed_rem_t list array;
   prev_untimed   : untimed_rem_t list;
   curr_untimed   : untimed_rem_t list;
   next_untimed   : untimed_rem_t list;
   all_untimed    : untimed_rem_t list;
   curr_counts    : int array;
   curr_cal       : Cal.t;
   remind_error   : string
}


(* Get the starting timestamp and time record for a given month *)
let month_start_of_tm tm =
   let month_start_tm = {empty_tm with
      Unix.tm_mon   = tm.Unix.tm_mon;
      Unix.tm_year  = tm.Unix.tm_year;
   } in
   Unix.mktime month_start_tm



(* Process information about a timed reminder, create a new reminder
 * record for it, and store it in the timed reminders array at the
 * proper indentation level.
 *
 * The indentation levels are determined by maintaining an array that indicates
 * which levels have been used for each hourly timeslot.  As each reminder is
 * processed, we look into the array to find the smallest indentation level
 * available.  Complexity is approximately
 * (number of reminders) * (average reminder duration).  Since indentation is
 * determined a month at a time, there may be some minor discrepancies at
 * month borders. *)
let process_timed tm duration_s month_start_ts indentations partial_trem 
timed =
   let (f_rem_ts, _) = Unix.mktime tm in
   let duration =
      if duration_s = "*" then 0.0
      else float_of_string duration_s
   in
   (* compute the indentation level *)
   (* top_index and bottom_index provide the range of row indices into
    * array indentations that are covered by this reminder *)
   let top_index = 
      try int_of_float ((f_rem_ts -. month_start_ts) /. 3600.0)
      with _ -> 0
   in
   let bottom_index = 
      try
         let real_bottom_index =
            let shift = 
               if duration > 0.0 then
                  (f_rem_ts +. (duration *. 60.0) -. month_start_ts) /. 3600.0
               else
                  (f_rem_ts +. (duration +. 60.0) -. month_start_ts) /. 3600.0
            in
            (* catch the edge effects when reminders end on hour boundaries *)
            if shift = float_of_int (int_of_float shift) then
               pred (int_of_float shift)
            else
               int_of_float shift
         in
         (* the bottom index could flow off of this month, in which case
          * we truncate and hope everything works out *)
         if real_bottom_index > pred (Array.length indentations) then
            pred (Array.length indentations)
         else
            real_bottom_index
      with _ -> top_index
   in
   (* locate the smallest free indentation level *)
   let rec find_indent level =
      if level < Array.length indentations.(0) then begin
         let collision = ref false in
         for i = top_index to bottom_index do
            if indentations.(i).(level) then
               collision := true
            else
               ()
         done;
         if !collision then
            find_indent (succ level)
         else begin
            for i = top_index to bottom_index do
               indentations.(i).(level) <- true
            done;
            level
         end
      end else
         (* give up and default to maximum indentation *)
         pred (Array.length indentations.(0))
   in
   let indent = find_indent 0 in 
   let trem = {partial_trem with
      tr_start      = f_rem_ts;
      tr_end        = f_rem_ts +. (duration *. 60.);
   } in
   timed.(indent) <- trem :: timed.(indent)



(* Obtain two lists of reminders for the month of the timestamp argument.
 * The first list is for timed reminders, the second is for untimed. 
 * The timed reminders list also provides the indentation levels that
 * draw_timed should use to render each reminder. 
 *
 * The indentation levels are determined by maintaining an array that indicates
 * which levels have been used for each hourly timeslot.  As each reminder is
 * processed, we look into the array to find the smallest indentation level
 * available.  Complexity is approximately
 * (number of reminders) * (average reminder duration).  Since indentation is
 * determined a month at a time, there may be some minor discrepancies at
 * month borders.
 *
 * The optional argument 'suppress_advwarn', if true, will override
 * the "advance_warning" rcfile option. *)
let month_reminders ?(suppress_advwarn=false) timestamp =
   let comment_regex = Str.regexp "^#.*fileinfo \\([^ ]+\\) \\(.*\\)$" in
   let rem_regex = Str.regexp "\\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\(.*\\)$" in
   let nodisplay_regex = Str.regexp_case_fold ".*nodisplay" in
   let noweight_regex = Str.regexp_case_fold ".*noweight" in
   let tm = Unix.localtime timestamp in
   let rem_date_str = (string_of_tm_mon tm.Unix.tm_mon) ^ " " ^ 
                      (string_of_int tm.Unix.tm_mday) ^ " " ^
                      (string_of_int (tm.Unix.tm_year + 1900)) in
   let remind_s_flag = 
      if suppress_advwarn then " -s"
      else if !Rcfile.advance_warning then " -sa"
      else " -s" in
   let full_remind_command =
      !Rcfile.remind_command ^ remind_s_flag ^ " -l -g -b2 " ^ 
      !Rcfile.reminders_file ^ " " ^ rem_date_str
   in
   let (out_lines, err_lines) = Utility.read_all_shell_command_output full_remind_command in
   (* check for Remind errors *)
   let remind_err = if List.length err_lines > 0 then List.hd err_lines else "" in
   let num_indentations = 4 in
   let indentations = Array.make_matrix (24 * 31) num_indentations false in
   let (month_start_ts, _) = month_start_of_tm tm in
   let timed = Array.make num_indentations [] in
   let rec build_lists lines untimed =
      begin match lines with
      | [] ->
         for i = 0 to pred (Array.length timed) do
            timed.(i) <- List.rev timed.(i)
         done;
         (remind_err, timed, List.rev untimed)
      | comment_line :: rem_line :: lines_tail ->
         begin try
            if Str.string_match comment_regex comment_line 0 then begin
               let line_num_s = Str.matched_group 1 comment_line
               and filename   = Str.matched_group 2 comment_line in
               if Str.string_match rem_regex rem_line 0 then begin
                  let date_s     = Str.matched_group 1 rem_line
                  and tag        = Str.matched_group 2 rem_line
                  and duration_s = Str.matched_group 3 rem_line
                  and min_s      = Str.matched_group 4 rem_line
                  and msg        = Str.matched_group 5 rem_line in
                  (* further subdivide the date string *)
                  let date_arr = Array.of_list (Str.split (Str.regexp "[/-]") date_s) in
                  let year     = int_of_string date_arr.(0)
                  and month    = int_of_string date_arr.(1)
                  and day      = int_of_string date_arr.(2) in
                  let temp = {empty_tm with
                     Unix.tm_mday  = day;
                     Unix.tm_mon   = pred month;
                     Unix.tm_year  = year - 1900;
                  } in
                  (* check whether this reminder is tagged 'nodisplay' *)
                  if (Str.string_match nodisplay_regex tag 0) then
                     (* skip this reminder due to a 'nodisplay' tag *)
                     build_lists lines_tail untimed
                  else begin
                     let has_weight = not (Str.string_match noweight_regex tag 0) in
                     if min_s = "*" then
                        (* if minutes are not provided, this must be an untimed reminder *)
                        let (f_rem_ts, _) = Unix.mktime temp in
                        let urem = {
                           ur_start      = f_rem_ts;
                           ur_msg        = msg;
                           ur_filename   = filename;
                           ur_linenum    = line_num_s;
                           ur_has_weight = has_weight
                        } in
                        build_lists lines_tail (urem :: untimed)
                     else begin
                        (* if minutes are provided, this must be a timed reminder *)
                        let temp_with_min = {temp with Unix.tm_min = int_of_string min_s} in
                        let partial_trem = {
                           tr_start      = 0.0;  (* still needs to be filled in *)
                           tr_end        = 0.0;  (* still needs to be filled in *)
                           tr_msg        = msg;
                           tr_filename   = filename;
                           tr_linenum    = line_num_s;
                           tr_has_weight = has_weight
                        } in
                        process_timed temp_with_min duration_s month_start_ts indentations
                        partial_trem timed;
                        build_lists lines_tail untimed
                     end
                  end
               end else
                  (* if there was no rem_regex match, continue with next line *)
                  build_lists (rem_line :: lines_tail) untimed
            end else
               (* if there was no comment_regex match, continue with next line *)
               build_lists (rem_line :: lines_tail) untimed
         with _ ->
            (* if there's an error in regexp matching or string coersion,
             * just drop that reminder and go to the next line *)
            build_lists (rem_line :: lines_tail) untimed
         end
      | comment_line :: [] ->
         (* this line doesn't conform to the spec, so throw it out *)
         build_lists [] untimed
      end
   in
   build_lists out_lines []


(* generate a count of how many reminders fall on any given day of
 * the month *)
let count_reminders month_start_tm timed untimed =
   let rem_counts = Array.make 31 0 in
   let count_rems start has_weight =
      let tm = Unix.localtime start in
      if has_weight && tm.Unix.tm_year = month_start_tm.Unix.tm_year &&
      tm.Unix.tm_mon = month_start_tm.Unix.tm_mon then
         let day = pred tm.Unix.tm_mday in
         rem_counts.(day) <- succ rem_counts.(day)
      else
         ()
   in
   let count_timed rem =
      count_rems rem.tr_start rem.tr_has_weight
   in
   let count_untimed rem =
      count_rems rem.ur_start rem.ur_has_weight
   in
   Array.iter (List.iter count_timed) timed;
   List.iter count_untimed untimed;
   rem_counts


(* generate a count of how many hours of reminders one has on
 * any given day of the month.  Note: some minor errors can
 * occur during DST, but this is too small to worry about. *)
let count_busy_hours month_start_tm timed untimed =
   let hour_counts = Array.make 31 0.0 in
   let last_day = 
      let temp = {month_start_tm with Unix.tm_mday = 32} in
      let (_, nextmonth) = Unix.mktime temp in
      32 - nextmonth.Unix.tm_mday
   in
   let count_hours start stop has_weight =
      if has_weight then
         for day = 1 to last_day do
            let day_tm = {month_start_tm with Unix.tm_mday = day} in
            let (day_ts, _) = Unix.mktime day_tm in
            if day_ts >= start then
               if stop > day_ts +. 86400. then
                  hour_counts.(pred day) <- hour_counts.(pred day) +. 24.
               else if stop > day_ts then
                  hour_counts.(pred day) <- hour_counts.(pred day) +.
                  ((stop -. day_ts) /. 3600.)
               else
                  ()
            else if day_ts +. 86400. > start then
               if stop > day_ts +. 86400. then
                  hour_counts.(pred day) <- hour_counts.(pred day) +.
                  24. -. ((start -. day_ts) /. 3600.)
               else
                  hour_counts.(pred day) <- hour_counts.(pred day) +.
                  ((stop -. start) /. 3600.)
            else
               ()
         done
      else
         ()
   in
   let count_timed rem =
      count_hours rem.tr_start rem.tr_end rem.tr_has_weight
   in
   let count_untimed rem =
      let stop = rem.ur_start +. (!Rcfile.untimed_duration *. 60.) in
      count_hours rem.ur_start stop rem.ur_has_weight
   in
   Array.iter (List.iter count_timed) timed;
   List.iter count_untimed untimed;
   Array.map int_of_float hour_counts


(* determine the busy-ness level for each day in the month *)
let count_busy month_tm timed untimed =
   let month_start_tm = {
      month_tm with Unix.tm_sec  = 0;
                    Unix.tm_min  = 0;
                    Unix.tm_hour = 0;
                    Unix.tm_mday = 1
   } in
   match !Rcfile.busy_algorithm with
   |1 -> count_reminders month_start_tm timed untimed
   |2 -> count_busy_hours month_start_tm timed untimed
   |_ -> Rcfile.config_failwith "busy_algorithm must be either 1 or 2"


(* comparison functions for sorting reminders chronologically *)
let cmp_timed rem_a rem_b =
   compare rem_a.tr_start rem_b.tr_start

let cmp_untimed rem_a rem_b =
   compare rem_a.ur_start rem_b.ur_start


(* take an array of timed reminder lists and merge them into
 * a single list sorted by starting timestamp *)
let merge_timed timed =
   let all_rem = ref [] in
   for i = 0 to pred (Array.length timed) do
      all_rem := List.rev_append timed.(i) !all_rem
   done;
   List.fast_sort cmp_timed !all_rem


(* same thing as List.append (or @), but tail-recursive *)
let safe_append a b = List.rev_append (List.rev a) b


(* initialize a new three-month reminder record *)
let create_three_month ?(suppress_advwarn=false) timestamp =
   let month_start_tm = {
      Unix.localtime timestamp with Unix.tm_sec  = 0;
                                    Unix.tm_min  = 0;
                                    Unix.tm_hour = 0;
                                    Unix.tm_mday = 1
   } in
   let (curr_ts, _) = Unix.mktime month_start_tm in
   let temp_prev = {
      month_start_tm with Unix.tm_mon = pred month_start_tm.Unix.tm_mon
   } in
   let temp_next = {
      month_start_tm with Unix.tm_mon = succ month_start_tm.Unix.tm_mon
   } in
   let (prev_ts, _) = Unix.mktime temp_prev
   and (next_ts, _) = Unix.mktime temp_next in
   let (pre, pt, pu) = month_reminders ~suppress_advwarn:suppress_advwarn prev_ts in
   let (cre, ct, cu) = month_reminders ~suppress_advwarn:suppress_advwarn curr_ts in
   let (nre, nt, nu) = month_reminders ~suppress_advwarn:suppress_advwarn next_ts in 
   let at = Array.make (Array.length pt) [] in
   for i = 0 to pred (Array.length at) do
      at.(i) <- safe_append pt.(i) (safe_append ct.(i) nt.(i))
   done;
   let err_str = 
      if String.length pre > 0 then
         pre
      else if String.length cre > 0 then
         cre
      else
         nre
   in
   let au = safe_append pu (safe_append cu nu) in {
      curr_timestamp = curr_ts;
      prev_timed     = pt;
      curr_timed     = ct;
      next_timed     = nt;
      all_timed      = at;
      prev_untimed   = pu;
      curr_untimed   = cu;
      next_untimed   = nu;
      all_untimed    = au;
      curr_counts    = count_busy month_start_tm at au;
      curr_cal       = Cal.make curr_ts !Rcfile.week_starts_monday;
      remind_error   = err_str   
   }



(* Update a three-month reminders record for the next month *)
let next_month reminders =
   let curr_tm = Unix.localtime reminders.curr_timestamp in
   let temp1 = {
      curr_tm with Unix.tm_mon = succ curr_tm.Unix.tm_mon
   } in
   let temp2 = {
      curr_tm with Unix.tm_mon = curr_tm.Unix.tm_mon + 2
   } in
   let (new_curr_timestamp, temp1) = Unix.mktime temp1 in
   let (next_timestamp, temp2)     = Unix.mktime temp2 in
   let (re, t, u) = month_reminders next_timestamp in 
   let at = Array.make (Array.length t) [] in
   for i = 0 to pred (Array.length t) do
      at.(i) <- safe_append reminders.curr_timed.(i) 
                (safe_append reminders.next_timed.(i) t.(i))
   done;
   let au = safe_append reminders.curr_untimed (safe_append reminders.next_untimed u) in {
      curr_timestamp = new_curr_timestamp;
      prev_timed     = reminders.curr_timed;
      curr_timed     = reminders.next_timed;
      next_timed     = t;
      all_timed      = at;
      prev_untimed   = reminders.curr_untimed;
      curr_untimed   = reminders.next_untimed;
      next_untimed   = u;
      all_untimed    = au;
      curr_counts    = count_busy temp1 at au;
      curr_cal       = Cal.make new_curr_timestamp !Rcfile.week_starts_monday;
      remind_error   = re
   }


(* Update a three-month reminders record for the previous month *)
let prev_month reminders =
   let curr_tm = Unix.localtime reminders.curr_timestamp in
   let temp1 = {
      curr_tm with Unix.tm_mon = pred curr_tm.Unix.tm_mon
   } in
   let temp2 = {
      curr_tm with Unix.tm_mon = curr_tm.Unix.tm_mon - 2
   } in
   let (new_curr_timestamp, temp1) = Unix.mktime temp1 in
   let (prev_timestamp, temp2)     = Unix.mktime temp2 in
   let (re, t, u) = month_reminders prev_timestamp in
   let at = Array.make (Array.length t) [] in
   for i = 0 to pred (Array.length t) do
      at.(i) <- safe_append t.(i) 
                (safe_append reminders.prev_timed.(i) reminders.curr_timed.(i))
   done;
   let au = safe_append u (safe_append reminders.prev_untimed reminders.curr_untimed) in {
      curr_timestamp = new_curr_timestamp;
      prev_timed     = t;
      curr_timed     = reminders.prev_timed;
      next_timed     = reminders.curr_timed;
      all_timed      = at;
      prev_untimed   = u;
      curr_untimed   = reminders.prev_untimed;
      next_untimed   = reminders.curr_untimed;
      all_untimed    = au;
      curr_counts    = count_busy temp1 at au;
      curr_cal       = Cal.make new_curr_timestamp !Rcfile.week_starts_monday;
      remind_error   = re
   }


(* Return a new reminders record centered on the current timestamp,
 * doing as little work as possible. *)
let update_reminders rem timestamp =
   let tm     = Unix.localtime timestamp
   and rem_tm = Unix.localtime rem.curr_timestamp in
   if tm.Unix.tm_year = rem_tm.Unix.tm_year &&
      tm.Unix.tm_mon  = rem_tm.Unix.tm_mon then
      rem
   else
      let temp1 = {
         rem_tm with Unix.tm_mon = pred rem_tm.Unix.tm_mon
      } in
      let temp2 = {
         rem_tm with Unix.tm_mon = succ rem_tm.Unix.tm_mon
      } in
      let (_, prev_tm) = Unix.mktime temp1 in
      let (_, next_tm) = Unix.mktime temp2 in
      if tm.Unix.tm_year = prev_tm.Unix.tm_year &&
         tm.Unix.tm_mon  = prev_tm.Unix.tm_mon then
         prev_month rem
      else if tm.Unix.tm_year = next_tm.Unix.tm_year &&
         tm.Unix.tm_mon = next_tm.Unix.tm_mon then
         next_month rem
      else
         create_three_month timestamp



(* Look at all 'next' reminders after the given timestamp.  Search
 * through the list for the first occurrence of the search regexp, and return
 * a timestamp for that date.
 * This calls 'remind -n' twice--once for the current day, once for the next day.
 * The second call is necessary because reminders falling on the current day
 * but before the current timestamp will effectively suppress later recurrences
 * of that reminder. 
 *
 * We also have to make a separate check that the matched reminder is not tagged
 * with 'nodisplay'; since these reminders don't show up on the display, Wyrd
 * should not be able to match them. *)
let find_next msg_regex timestamp =
   let rem_regex = 
      Str.regexp "^\\([^ ]+\\)[/-]\\([^ ]+\\)[/-]\\([^ ]+\\) [^ ]+ \\([^ ]+\\) [^ ]+ \\([^ ]+\\) \\([^ ]+.*\\)$"
   in
   let nodisplay_regex = Str.regexp_case_fold ".*nodisplay" in
   let tm1 = Unix.localtime timestamp in
   let temp = {tm1 with Unix.tm_mday = succ tm1.Unix.tm_mday} in     (* add 24 hours *)
   let (_, tm2) = Unix.mktime temp in
   let rem_date_str1 = (string_of_tm_mon tm1.Unix.tm_mon) ^ " " ^ 
                       (string_of_int tm1.Unix.tm_mday) ^ " " ^
                       (string_of_int (tm1.Unix.tm_year + 1900)) in
   let rem_date_str2 = (string_of_tm_mon tm2.Unix.tm_mon) ^ " " ^ 
                       (string_of_int tm2.Unix.tm_mday) ^ " " ^
                       (string_of_int (tm2.Unix.tm_year + 1900)) in
   let remind_output_for_month date_str =
      let remind_month_command = 
         !Rcfile.remind_command ^ " -n -s -b1 " ^ !Rcfile.reminders_file ^ " " ^ date_str
      in
      let (out_lines, _) = Utility.read_all_shell_command_output remind_month_command in
      out_lines
   in
   (* concatenate the outputs from two consecutive months of Remind data, then sort
    * the lines by leading datestamp *)
   let two_month_output = List.rev_append 
      (remind_output_for_month rem_date_str1) (remind_output_for_month rem_date_str2)
   in
   let out_lines = List.fast_sort compare two_month_output in
   let rec check_messages lines =
      begin match lines with
      | [] ->
         raise Occurrence_not_found
      | line :: lines_tail ->
         begin try
            if Str.string_match rem_regex line 0 then begin
               (* go here if this line is a timed reminder *)
               let year  = int_of_string (Str.matched_group 1 line)
               and month = int_of_string (Str.matched_group 2 line)
               and day   = int_of_string (Str.matched_group 3 line)
               and tag   = Str.matched_group 4 line
               and min_s = Str.matched_group 5 line
               and msg   = Str.matched_group 6 line in
               let temp = {empty_tm with
                  Unix.tm_min   = if min_s = "*" then 0 else (int_of_string min_s);
                  Unix.tm_mday  = day;
                  Unix.tm_mon   = pred month;
                  Unix.tm_year  = year - 1900;
               } in
               let (ts, _) = Unix.mktime temp in
               if ts > timestamp then
                  begin try
                     let _ = Str.search_forward msg_regex msg 0 in
                     (* only return the match if this value is not tagged 'nodisplay' *)
                     if not (Str.string_match nodisplay_regex tag 0) then
                        ts
                     else
                        check_messages lines_tail
                  with Not_found ->
                     check_messages lines_tail
                  end
               else begin
                  check_messages lines_tail
               end
            end else
               (* if there was no regexp match, continue with next line *)
               check_messages lines_tail
         with
         | Failure s ->
           (* if there's an error in string coersion, just drop that reminder and go
            * to the next line *)
           check_messages lines_tail
         end
      end
   in
   check_messages out_lines


(* Get a list of file or directory names INCLUDEd in a specific reminders file *)
let parse_include_directives remfile =
   let filedir = Filename.dirname remfile in
   try
      let remfile_channel = open_in remfile in
      (* match "include <filename>" *)
      let include_regex = Str.regexp_case_fold "^[ \t]*include[ \t]+\\([^ \t]+.*\\)$" in
      (* match "[filedir()]" so we can do a Remind-like directory substitution *)
      let filedir_regex = Str.regexp_case_fold "\\[[ \t]*filedir[ \t]*([ \t]*)[ \t]*\\]" in
      let rec build_filelist files =
         try
            let line = input_line remfile_channel in
            if Str.string_match include_regex line 0 then
               let include_expr = Utility.strip (Str.matched_group 1 line) in
               let new_file = Str.global_replace filedir_regex filedir include_expr in
               build_filelist (new_file :: files)
            else
               build_filelist files
         with End_of_file ->
            close_in remfile_channel;
            files
      in
      build_filelist []
   with Sys_error _ ->
      (* File does not exist *)
      []


(* Given a directory name and an open handle to it, locate all *.rem files contained therein.
 * Closes the directory handle on exit. *)
let find_remdir_scripts dirname remdir_handle =
   let safe_get_filename () =
      try
         Some (Unix.readdir remdir_handle)
      with End_of_file ->
         None
   in
   let rec listdir filelist =
      match safe_get_filename () with
      | Some filename ->
         listdir ((Filename.concat dirname filename) :: filelist)
      | None ->
         Unix.closedir remdir_handle;
         filelist
   in
   let is_rem_script filename = Filename.check_suffix filename ".rem" in
   List.filter is_rem_script (listdir [])


(* Recursively compute a subtree of reminder files that Remind would execute
 * as a result of a single INCLUDE directive.  <pending_include_directives> is a list of 
 * files and directories specified via a number of Remind INCLUDE statements.
 * <known_include_directives> is a Set of include directives which have already been
 * processed.  <known_included_filenames> is a list of filenames which are already
 * known to be included; this is effectively a subset of the <known_include_directives>.
 *
 * We test that a file or directory has been visited by statting it and testing for
 * containment of the (dev, inode) pair in the Set <known_include_directives>.  This should
 * do the right thing in case of symlinks, relative paths, etc. *)
let rec get_included_filenames known_included_filenames known_include_directives pending_include_directives =
   match pending_include_directives with
   | [] ->
      List.fast_sort compare known_included_filenames
   | include_directive :: remaining_include_directives ->
      begin try
         (* The (dev, inode) pair uniquely identifies a file or directory. *)
         let directive_id =
            let status = Unix.stat include_directive in
            (status.Unix.st_dev, status.Unix.st_ino)
         in
         if IPSet.mem directive_id known_include_directives then
            (* This include directive has already been processed... skip it *)
            get_included_filenames known_included_filenames known_include_directives 
               remaining_include_directives
         else
            begin try
               (* This is a new include directive.  Start by assuming it's a directory.  If that works,
                * treat each of the .rem scripts inside this directory as a new INCLUDE directive. *)
               let remdir_handle = Unix.opendir include_directive in
               let new_include_directives = find_remdir_scripts include_directive remdir_handle in
               get_included_filenames known_included_filenames
                  (IPSet.add directive_id known_include_directives)
                  (List.rev_append new_include_directives remaining_include_directives)
            with Unix.Unix_error _ ->
               (* This include directive could not be opened as a directory.
                * Treat it as a regular file: parse it to locate additional
                * INCLUDE lines, and add the additional includes to the pending list. *)
               let new_include_directives = parse_include_directives include_directive in
               get_included_filenames (include_directive :: known_included_filenames) 
                  (IPSet.add directive_id known_include_directives) 
                  (List.rev_append new_include_directives remaining_include_directives)
            end
      with Unix.Unix_error (Unix.ENOENT, _, _) ->
         (* include_directive cannot be found on disk... skip it *)
         get_included_filenames known_included_filenames known_include_directives 
            remaining_include_directives
      end
   

(* Get a tuple of the form (primary remfile, all remfiles).  If !Rcfile.reminders_file
 * is a single file, then "primary_remfile" is that file, and "all_remfiles" is
 * formed by parsing the INCLUDE statements.  If !Rcfile.reminders_file is
 * a directory, then "primary remfile" is the first file in the directory with
 * extension ".rem", and "all remfiles" is all files with extension ".rem"
 * combined with all INCLUDEd files. *)
let get_all_remfiles () =   
   (* Test whether a filename represents an existing directory. *)
   let is_existing_dir fn =
      try 
         let status = Unix.stat fn in
         status.Unix.st_kind = Unix.S_DIR
      with Unix.Unix_error _ ->
         false
   in
   let toplevel_include_directive = Utility.expand_file !Rcfile.reminders_file in
   if is_existing_dir toplevel_include_directive then
      try
         let toplevel_scripts = find_remdir_scripts toplevel_include_directive
            (Unix.opendir toplevel_include_directive)
         in
         if toplevel_scripts = [] then
            (* User selected an empty reminders directory.  Make up a reasonable default filename. *)
            let default_filename = Filename.concat toplevel_include_directive "reminders.rem" in
            (default_filename, [default_filename])
         else
            (* Nonempty reminders directory.  Choose first entry as primary file, and parse
             * through all files to get the INCLUDE structure. *)
            let sorted_scripts = List.fast_sort compare toplevel_scripts in
            (List.hd sorted_scripts,
               get_included_filenames [] IPSet.empty sorted_scripts)
      with Unix.Unix_error _ ->
         (* Can't open the directory... *)
         failwith (Printf.sprintf "Can't open reminders directory \"%s\"" 
            toplevel_include_directive)
   else
      (* toplevel include directive is not a directory.  Treat it as a regular file,
       * which need not exist. *)
      let all_includes = get_included_filenames [] IPSet.empty [toplevel_include_directive] in
      if all_includes = [] then
         (* Special case: if the toplevel include does not exist, pretend it does exist *)
         (toplevel_include_directive, [toplevel_include_directive])
      else
         (toplevel_include_directive, all_includes)



(* Filter a list of untimed reminders, returning a list of those
 * reminders falling on the same day as the timestamp. *)
let get_untimed_reminders_for_day untimed_reminders timestamp =
   let curr_tm = Unix.localtime timestamp in
   let temp1 = {
      curr_tm with Unix.tm_sec  = 0;
                   Unix.tm_min  = 0;
                   Unix.tm_hour = 0
   } in
   let temp2 = {
      curr_tm with Unix.tm_sec  = 0;
                   Unix.tm_min  = 0;
                   Unix.tm_hour = 0;
                   Unix.tm_mday = succ curr_tm.Unix.tm_mday 
   } in
   let (day_start_ts, _) = Unix.mktime temp1 in
   let (day_end_ts, _)   = Unix.mktime temp2 in
   let is_current rem =
      rem.ur_start >= day_start_ts && rem.ur_start < day_end_ts
   in
   List.filter is_current untimed_reminders


(* Forms a list of all remfiles in use, and stats them all to
 * get the mtimes. *)
let get_remfile_mtimes () =
   let safe_mtime filename =
      try
         let st = Unix.stat filename in
         st.Unix.st_mtime
      with Unix.Unix_error _ ->
         0.0
   in
   let (_, all_remfiles) = get_all_remfiles () in
   List.fold_left
      (fun acc remfile -> Interface.SMap.add remfile (safe_mtime remfile) acc)
      Interface.SMap.empty
      all_remfiles


(* arch-tag: DO_NOT_CHANGE_6bb48a1c-2b0c-4254-ba3a-ee9b48007169 *)