; timeclock functionnality
(require 'timeclock)
(require 'calendar)

;(timeclock-modeline-display)
(add-hook 'kill-emacs-hook 'timeclock-query-out)
 
;; planner mode

;;; helper functions

(defun planner-date-to-calendar (date)
  "Convert a planner date string like \"YYYY.MM.DD\" in
   a calendar date list (month day year)."
  (let ((split-date 
         (mapcar 'string-to-number 
                 (split-string (file-name-nondirectory date) "\\."))))
    (list (nth 1 split-date) 
          (nth 2 split-date)
          (nth 0 split-date))))

(defsubst calendar-date-to-planner (date)
; "Convert a planner date string like \"YYYY.MM.DD\" in
; a calendar date list (month day year)."
  (format "%04d.%02d.%02d"
          (nth 2 date)
          (nth 0 date)
          (nth 1 date)))

;; Moving functions

(defun planner-goto-schedule ()
  "Create if necessary and go to a Schedule section in current planner.
Ensure to preserved the buffer-modified-p value so that a kill will not
preserve the automated change for nothing."
  (interactive)
  (goto-char (point-min))
  (let ((modified (buffer-modified-p)))
    (unless (re-search-forward "^\\* Schedule\n\n" nil t)
      (re-search-forward "^\\* Notes")
      (beginning-of-line)
      (insert "* Schedule\n\n\n\n")
      (forward-line -2)
      (set-buffer-modified-p modified))))

(defun planner-goto-events ()
  "Create if necessary and go to a Events section just before the
Schedule one (which is also create if necessary) in current planner.
Ensure to preserved the buffer-modified-p value so that a kill will
not preserve the automated change for nothing."
  (interactive)
  (goto-char (point-min))
  (let ((modified (buffer-modified-p)))
    (unless (re-search-forward "^\\* Events\n\n" nil t)
      (planner-goto-schedule)
      (re-search-backward "^\\* Schedule")
      (insert "* Events\n\n\n\n")
      (forward-line -2)
      (set-buffer-modified-p modified))))

;; The reminders converter.
;;
;; It now used a custom diary file, so you
;; can included it without breaking your normal diary-file.
;; The function can also set some arguments.  I used it to call
;; a modified remconv which accept a "euro" argument to output
;; euro style date.
;;
;; I no more used those ones now since I'm directly marking the
;; calendar and the add-appt from the planner files.

(defcustom planner-diary-file diary-file
  "Diary file where to add planner entries.  You can set this value to
another file than `diary-file' and add in `diary-file' the #include
\"~/your-planner-diary-file-name\".  Just make sure that you call
`planner-convert-reminders' before `include-other-diary-files' in the
`list-diary-entries-hook'."
  :type 'file
  :group 'planner)

(defcustom planner-remconv-command "remconv"
  "A command that output diary compatible entries.  Can take arguments
also."
  :type 'string
  :group 'planner)

(defun planner-convert-reminders ()
  "Generate a diary file from a .reminders file.
You can add this this function to the `list-diary-entries-hook'"
  (with-current-buffer (find-file-noselect planner-diary-file)
    (erase-buffer)
    (insert (shell-command-to-string planner-remconv-command))
    (save-buffer)))

;; redefinition of planner-maybe-remove-file 
;;
;; The kill-buffer of this function make me crazy.  I modify it so you
;; can change it's behavior using this custom variable.  Personnaly, I
;; used ignore and let emacs ask me to save it when I kill it.  Take
;; also note that I change the regexp to remove any file that only
;; have empty section (section with just a first level heading).  This
;; is to cope with the new Events and Schedule sections.

(defcustom planner-not-empty-file 'kill-this-buffer
  "Command to run when a planner file is not empty.  Can be
kill-this-buffer, save-buffer or ignore for example."
  :type 'function
  :group 'planner)

(defvar local-planner-empty-line-regexp "\\(\\* .*\\|[[:space:]]*\\)")
(defvar planner-empty-file-regexp 
  (concat "\\(^" local-planner-empty-line-regexp
          "\n\\)*[[:space:]]*\\'"))

; redefinition

(defun planner-maybe-remove-file ()
  "This function remove the file if it contains only first level
headings and empty lines."
  (interactive)
  (goto-char (point-min))
  (if (looking-at planner-empty-file-regexp)
      (let ((filename buffer-file-name))
	(set-buffer-modified-p nil)
	(kill-buffer (current-buffer))
	(delete-file filename))
    (funcall planner-not-empty-file)))

;; planner-browse-url bbdb url handling
;;
;; My emacs-wiki doesn't like bbdb url like [[bbdb://Fabien Niņoles]]
;; I make this advice so he can replace _ with space and __ with _ in the
;; url before letting planner-browse-url handling it.

(defadvice planner-browse-url (before local-bbdb-url-pretreatment (url))
  "Pretreatment of some URL."
  (if (string-match "^bbdb://\\(.+\\)" url)
      (setq url
            (mapconcat 
             '(lambda (str) (subst-char-in-string ?_ ?  str t))
             (split-string url "__")
             "_"))))

(ad-activate 'planner-browse-url)

;; diary support functions
;;
;; This functions add diary entries into the Schedule and Events
;; sections of a planner buffer.  I hook it to the
;; `planner-seek-to-first' function and only if the Events section
;; doesn't already exist.  The best should be that it check if the
;; entry doesn't exist already instead but currently it works pretty
;; good.  You can always call it interactively if you want to update
;; your Events/Schedule.  Just make sure that you don't add the
;; `planner-convert-reminder' set in the `list-diary-entries-hook'
;; setup.

(defun planner-insert-diary ()
  "Insert the diary schedule in the planner buffer."
  (interactive)
  (let*
    ((entries (list-diary-entries (planner-date-to-calendar (emacs-wiki-page-name)) 1))
     (events))
    (planner-goto-schedule)
    (while entries
      (let* ((entry (nth 1 (car entries)))
             (lines (split-string entry "\n"))
             (line))
        (while (setq line (car lines))
          (if (string-match
               "^[[:space:]]*\\([0-9]+:[0-9]\\{2\\}\\(?:am\\|pm\\)?\\)\\(-[0-9]+:[0-9]\\{2\\}\\(?:am\\|pm\\)?\\)?[[:space:]]+\\(.*\\)$" 
               line)
          (let ((starttime (match-string 1 line))
                (endtime (match-string 2 line))
                (description (match-string 3 line)))
            (insert (concat "  " starttime
                            " | " description
                            (if endtime
                                (let
                                    ((minutes
                                      (- (appt-convert-time (substring endtime 1 nil))
                                         (appt-convert-time starttime))))
                                  (format " (%d:%02d)"
                                          (/ minutes 60)
                                          (% minutes 60)))
                                "")
                              "\n")))
          (setq events (cons line events)))
          (setq lines (cdr lines))))
      (setq entries (cdr entries)))
    (planner-goto-events)
    (while events
      (insert (concat " - " (car events) "\n"))
      (setq events (cdr events)))))

(defadvice planner-seek-to-first (after planner-insert-diary-ad ())
  "Insert the diary into a newly create buffer."
  (if (string-match planner-date-regexp (emacs-wiki-page-name))
      (save-excursion
        (goto-char (point-min))
        (if (not (re-search-forward "^\\* Events[[:space:]]*$" nil t))
            (planner-insert-diary)))))

(ad-activate 'planner-seek-to-first)

;; appt support
;;
;; I'm loading now my appointments directly from the planner list.  It
;; has the same functionnality as the regular appt-make-list,
;; including its own planner-prev-appt-check variable.  It's set as an
;; after-advice to appt-check.  I also add a function that parse the
;; current line and add the appt to it's list.  The
;; planner-appt-entry-regexp are setup to catch any 'HH:MM | Message
;; (HH:MM)' line (just like allrems). You can set it up also to ignore
;; some special line (like those beginning with '&' for example).

(require 'appt)

(defvar planner-appt-entry-regexp 
  "^[[:space:]]*\\([0-9]+:[0-9]\\{2\\}\\)[[:space:]]*|[[:space:]]*\\([^&].*\\)[[:space:]]*\\(([0-9]+:[0-9]\\{2\\})\\)?[[:space:]]*$"
  "Regexp that match a appt entry in planner.")

(defun planner-appt-add ()
  "Add this line as an appointment.  The line should match
`planner-appt-entry-regexp'."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (looking-at planner-appt-entry-regexp)
        (appt-add (match-string-no-properties 1) (match-string-no-properties 2))
      (error "No appointment on this line"))))

(defun planner-make-appt-list ()
  "Load today planner file and make appt-list from schedule."
  (interactive)
  (save-excursion
    (save-window-excursion 
      (planner-goto-today)
      (while (re-search-forward planner-appt-entry-regexp nil t)
        (appt-add (match-string-no-properties 1) (match-string-no-properties 2))))))

(defvar planner-prev-appt-check nil
  "Determine the last time appt-check are called")

(defadvice appt-check (after planner-appt-check-ad ())
  "Call planner-make-appt-list the first time and every day."
  (let* ((now (decode-time))
         (cur-hour (nth 2 now))
         (cur-min (nth 1 now))
         (cur-comp-time (+ (* cur-hour 60) cur-min)))
    (if (or (null planner-prev-appt-check)
            (< cur-comp-time planner-prev-appt-check))
        (planner-make-appt-list))
    (setq planner-prev-appt-check cur-comp-time)))

(ad-activate 'appt-check)

;; calendar support
;;
;; This function are used to mark calendar entries directly from the
;; planner files.  I try to optimize it with a helper function that
;; take the list of planner-date string corresponding to the three
;; months display of the calendar (same behavior as the
;; mark-diary-entries-hook).  One of the helper are made in elisp, and
;; the other used an external perl script to parse the entries.  The
;; only thing check is a non-empty (I mean non-space) Events section.
;; Used it as a hook to the `mark-diary-entries-hook'.  Since this
;; function also search for diary entries, you can used it in
;; conjunction with diary.  And with the `planner-diary-insert'
;; function, you just have to type 'n' at the calendar day to see both
;; the diary and your normal planner entry.  The helper script is call events
;; and it's very short (see documentation of planner-mark-calendar-external-helper
;; for the script. The script also return the entry line so that you can remove
;; specially mark entry if you care, either by directly modifying the
;; script or by modifying the planner-mark-calendar-external-helper
;; function.

(defcustom planner-mark-calendar-helper 'planner-mark-calendar-internal-helper
  "Helper function to determinate which day have a non-empty events.
Currently, it exist two functions to do it:
`planner-mark-calendar-internal-helper' which is a lisp
implementation, and `planner-mark-calendar-external-helper' which used
a external script to do most of the parsing."
  :type 'function
  :group 'planner)

(defun planner-mark-calendar ()
  "Look for planner file with non-empty events."
  (save-window-excursion
    (set-buffer calendar-buffer)
    (let ((prev-month displayed-month)
          (prev-year displayed-year)
          (succ-month displayed-month)
          (succ-year displayed-year)
          (last-day)
          (day)
          (files nil))
      (increment-calendar-month succ-month succ-year 1)
      (increment-calendar-month prev-month prev-year -1)
      (setq day (calendar-absolute-from-gregorian (list prev-month 1 prev-year)))
      (setq last-day 
            (calendar-absolute-from-gregorian 
             (list succ-month 
                   (calendar-last-day-of-month succ-month succ-year)
                   succ-year))) 
      (while (<= day last-day)
        (let* ((date (calendar-gregorian-from-absolute day))
               (file 
                (expand-file-name 
                 (calendar-date-to-planner date)
                 planner-directory)))
          (if (file-readable-p file)
              (setq files (cons file files))))
        (setq day (1+ day)))
      (setq files (funcall planner-mark-calendar-helper files))
      (while files
        (mark-visible-calendar-date (planner-date-to-calendar (car files)))
        (setq files (cdr files))))))

(defun planner-mark-calendar-internal-helper (files)
  "Local (elisp) helper function for `planner-mark-calendar'."
  (let ((correct))
    (while files
      (find-file-other-window (car files))
      (goto-char (point-min))
      (if (re-search-forward "^\\* Events" nil t)
          (progn
            (forward-line 1)
            (if (re-search-forward 
                 "[^[:space:]]+"
                 (save-excursion
                   (re-search-forward "^\\* " nil t)
                   (let ((p (match-beginning 0)))
                     (and p (1- p))))
                 t)
                (setq correct (cons (car files) correct)))))
      (if (not (buffer-modified-p)) (kill-this-buffer))
      (setq files (cdr files)))
    correct))

(defcustom planner-mark-calendar-external-script "events %s"
  "Command line that select files that must be marked.
This string is send to the shell with %s replace with a list
of space separate (maybe non-existing) file names. An example
of such script follow:

#!/usr/bin/perl -s

for $file (sort @ARGV) {
    open (FILE, $file) || die \"Cannot open file $file\\n\";
    $inevents = 0;
    while (<FILE>) {
            if ($inevents == 0) {
                if (/^\\* Events/) {
                    $inevents = 1;
                }
            } elsif (/^\\* /) {
                $inevents = 0;
                break;
            }
            elsif (/^\\s*\\S/) {
                printf \"$file: $_\";
            }
        }
    close (FILE);
};
"
  :type 'string
  :group 'planner)
  
(defun planner-mark-calendar-external-helper (files)
  "Use an external application to parse the planner files.
The command line is set with the `planner-mark-calendar-external-script'
variable and must take a list of files as arguments."
  (let* ((command (concat "events " 
                         (mapconcat 'identity files " ")))
         (output (split-string (shell-command-to-string command) "\n"))
         (results))
    (while output
      (if (string-match "^\\([^:]+\\):" (car output))
          (setq results 
                (cons (match-string 1 (car output))
                      results)))
      (setq output (cdr output)))
    results))


;; planner-mode key mapping
;;
;; No comment for this one.  Do ye want.

(eval-after-load "planner"
  '(progn
     (define-key planner-mode-map [(control ?c) (control ?w)]
       'planner-goto-schedule)
     (define-key planner-mode-map [(control ?c) (control ?n)]
       'planner-create-note)
     (define-key planner-mode-map [(control ?c) (control ?e)]
       'planner-appt-add)))

;; global key mapping

(define-key ctl-x-map "ta" 'planner-create-task)
(define-key ctl-x-map "ts" 'planner-goto-today)
(define-key ctl-x-map "ti" 'timeclock-in)
(define-key ctl-x-map "to" 'timeclock-out)
(define-key ctl-x-map "tc" 'timeclock-change)
(define-key ctl-x-map "tr" 'timeclock-reread-log)
(define-key ctl-x-map "tv" 'timeclock-status-string)
;(define-key ctl-x-map "tu" 'timeclock-update-modeline)
;(define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)


(defun local-planner-kill-buffer ()
  "Kill the buffer and erase it if empty."
  (interactive)
  (let (
        (planner-not-empty-file 'kill-this-buffer)
;        (planner-not-empty-file (lambda () (save-buffer) (kill-this-buffer)))
       )
    (planner-maybe-remove-file)))

;; planner-mode  key mapping
(eval-after-load "planner"
  '(progn
     (define-key planner-mode-map [(control ?c) (control ?w)]
       'planner-goto-schedule)
     (define-key planner-mode-map [(control ?c) (control ?n)]
       'planner-create-note)
     (define-key planner-mode-map [(control ?c) (control ?k)]
       'local-planner-kill-buffer)
     (define-key planner-mode-map [(control ?c) (control ?e)]
       'planner-appt-add)))

;; global key mapping

(define-key ctl-x-map "ta" 'planner-create-task)
(define-key ctl-x-map "ts" 'planner-goto-today)
(define-key ctl-x-map "tj" 'planner-goto)
(define-key ctl-x-map "ti" 'timeclock-in)
(define-key ctl-x-map "to" 'timeclock-out)
(define-key ctl-x-map "tc" 'timeclock-change)
(define-key ctl-x-map "tr" 'timeclock-reread-log)
(define-key ctl-x-map "tv" 'timeclock-status-string)
;(define-key ctl-x-map "tu" 'timeclock-update-modeline)
;(define-key ctl-x-map "tw" 'timeclock-when-to-leave-string)

(provide 'local-planner)