;;;  diary-private.el -- functions for private diaries
;;
;; $Id: diary-private.el,v 1.11 2006/01/03 08:18:57 saschal Exp $

;;; Description:

;;  This file extends diary-lib to maintain a collection of private
;;  diary files, one for a month.  Filenames are choosen an a monthly
;;  basis, e.g. 1999-07 for July 1999 and are stored in the
;;  customizable location specified in `diary-private-dir' (defaults
;;  to "~/.diary").  You can insert default, islamic and hebrew dated
;;  entries.
;;
;;  Defined keystrokes:
;;
;;   i p    - insert-private-diary-entry
;;   i i p  - insert-private-islamic-diary-entry
;;   i h p  - insert-private-hebrew-diary-entry
;;
;;  I'm sorry, but neither islamic nor hebrew entries are marked or
;;  can be viewed from the calendar.  I didn't figure out how to add
;;  this.  Maybe you have some suggestions ;)
;;
;;  Some hooks are used from here:
;;
;;    (add-hook 'diary-display-hook 'fancy-diary-display)
;;    (add-hook 'list-diary-entries-hook 'include-private-diary-files)
;;    (add-hook 'mark-diary-entries-hook 'mark-private-diary-files)
;;
;;  to mark and display your private entries in calendar.  Fancy display is
;;  used since simple display only scans the `main'-diary file.
;;
;;

;;; Installation:

;;  To use this file, just specify
;;
;;                  (require 'diary-private)
;;
;;  in you .emacs file.

;;; Author:

;;  Sascha Lüdecke
;;  e-mail: sascha@meta-x.de
;;  URL   : http://meta-x.de/software

;;; Changes:

;; 0 1.11 date: 2006/01/03
;;   - fixed broken display when current month was january or december
;;     (entries of the other year didn't show up)
;;   - replaced tabs with spaces
;;   - Version 1.10 was skipped
;;
;; o 1.9 date: 2004/01/21
;;   - filenames are now 2004-01.txt instead of 2004-01
;;
;; o 1.8 date: 1999/12/27
;;   - comment changed
;;   - new location entered
;;
;; o 1.7 date: 1999/07/30
;;   - time not longer separated from date by --, now by `  '
;;
;; o 1.6 date: 1999/07/27
;;   - comments adjusted
;;   - function diary-private-make-entry no longer causes insertion
;;     of daynames when called with calendar-date-string
;;
;; o 1.5 date: 1999/07/27
;;   - Internal function separated from external ones.  Last are
;;     called from outside
;;   - new function `diary-private-make-entry' similiar to
;;     make-diary-entry uses given function-pointer to compute date
;;     string and inserts an entry into the file determined by
;;     `diary-private-get-actual-file'
;;   - insert-private{-hebrew|-islamic}-entry make use of
;;     diary-private-make-entry
;;
;; o 1.4 date: 1999/07/19
;;   - comments on functions improved
;;
;; o 1.3 date: 1999/07/19
;;   - fancy-diary-display added since simple-display does only read
;;     the main file.
;;   - computation of actual filename for new entries improved with
;;     format
;;   - computation of filenames for listing and displaying moved to
;;     a own function: diary-get-private-files makes use of format
;;     too
;;
;; o 1.2 date: 1999/07/18
;;   - documentation extended
;;   - contact information added
;;   - insert-private-islamic-diary-entry,
;;     insert-private-islamic-diary-entry added.  So far those
;;     entries are not recognized from calendar
;;   - superflous existance and readibility-check removed from
;;     include-private- and mark-private- functions
;;
;; o 1.1 date: 1999/07/16
;;   - Initial version
;;

;;; Code:

(require 'diary-lib)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Adjust this for your needs:

(defcustom diary-private-dir
  (concat (getenv "HOME") "/.diary")
  "Directory containing private diaries, one file per month looking
like 1999-07 for july 1999."
  :group 'diary
  :type 'directory
  :require 'diary-lib
  )

;;; other setting, like hooks and keys
;;
;; Let calendar mark and display all entries
(add-hook 'list-diary-entries-hook 'include-private-diary-files)
(add-hook 'mark-diary-entries-hook 'mark-private-diary-files)
(add-hook 'diary-display-hook 'fancy-diary-display)

(define-key calendar-mode-map "ip"  'insert-private-diary-entry)
(define-key calendar-mode-map "iip"  'insert-private-islamic-diary-entry)
(define-key calendar-mode-map "ihp"  'insert-private-hebrew-diary-entry)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Internal functions used from inside this file
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun diary-private-get-actual-file ()
  "Returns an absolute filename build from current year and month."
  (interactive)
  (let* ((today (calendar-cursor-to-date t))
         (month (extract-calendar-month today))
         (year (extract-calendar-year today))
         )
    (format "%s/%04d-%02d.txt" diary-private-dir year month)
    )
  )


(defun diary-get-private-files ()
  "Returns a list of files matching the three months displayed in
calendar.  All names returned are absolute and reflect real files."
  (let (regexp)
    (save-excursion
      (set-buffer calendar-buffer)
      ;; [pending] what if displayed month is january or december?
      ;; what happens to next/previous month?
      (let ((m displayed-month)
            (y displayed-year))
        (increment-calendar-month m y -1)
        (setq regexp (format "^\\(%04d-%02d" y m))
        (increment-calendar-month m y 1)
        (setq regexp (format "%s\\|%04d-%02d" regexp y m))
        (increment-calendar-month m y 1)
        (setq regexp (format "%s\\|%04d-%02d\\).txt$" regexp y m))
        )
      )
    (directory-files diary-private-dir
                     t
                     regexp
                     )
    )
  )


(defun diary-private-make-entry (arg datefunc)
  "Makes a private diary-entry, computing date string with given
`datefunc', which must be a function, returning string.  If the
choosen date is the current date, a timestamp is added."
  (let ((calendar-date-display-form calendar-date-display-form))
    (if (equal (calendar-cursor-to-date t) (calendar-current-date))
        (setq calendar-date-display-form
              (append calendar-date-display-form
                      '("  "
                        ;;; [xox] local patch since LOCALE isn't set right
                        ;;;(format-time-string "%X")))
                        (format-time-string "%T")))
              )
      )
    ;; No daynames from calendar-date-string
    (if (equal datefunc 'calendar-date-string)
        (setq datefunc (list datefunc '(calendar-cursor-to-date t) nil t))
      (setq datefunc (list datefunc '(calendar-cursor-to-date t)))
      )
    (make-diary-entry (eval-expression datefunc)
                      arg
                      (diary-private-get-actual-file)
                      )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Functions to be used from outside.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun insert-private-diary-entry (arg)
  "Insert an entry into a private diary for the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")
  (diary-private-make-entry arg 'calendar-date-string)
  )


(defun insert-private-islamic-diary-entry (arg)
  "Insert an entry into a private diary for the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")
  (diary-private-make-entry arg 'calendar-islamic-date-string)
  )


(defun insert-private-hebrew-diary-entry (arg)
  "Insert an entry into a private diary for the date indicated by point.
Prefix arg will make the entry nonmarking."
  (interactive "P")
  (diary-private-make-entry arg 'calendar-hebrew-date-string)
  )


(defun include-private-diary-files ()
  "Includes all private diary files to display them.  This function is
suitable for use in `list-diary-entries-hook' just like
`include-other-diary-files'."
  (let ((list-diary-entries-hook 'nil)
        diary-file)
    (mapc
     (lambda (diary-file)
       (unwind-protect
           (setq diary-entries-list
                 (append diary-entries-list
                         (list-diary-entries original-date number)))
         (kill-buffer (find-buffer-visiting diary-file))))
     (diary-get-private-files))))


(defun mark-private-diary-files ()
  "Marks all private diary files.  This function is suitable for use
in `mark-diary-entries-hook' just like `mark-other-diary-files'."
  (let (diary-file
        (mark-diary-entries-hook 'nil))
    (mapc
     (lambda (diary-file)
       (mark-diary-entries)
       (kill-buffer (find-buffer-visiting diary-file)))
     (diary-get-private-files))))


;; ===========================================================================
;; FIX for some twitches

(defun list-diary-entries (date number)
  "Create and display a buffer containing the relevant lines in diary-file.
The arguments are DATE and NUMBER; the entries selected are those
for NUMBER days starting with date DATE.  The other entries are hidden
using selective display.

Returns a list of all relevant diary entries found, if any, in order by date.
The list entries have the form ((month day year) string specifier) where
\(month day year) is the date of the entry, string is the entry text, and
specifier is the applicability.  If the variable `diary-list-include-blanks'
is t, this list includes a dummy diary entry consisting of the empty string)
for a date with no diary entries.

After the list is prepared, the hooks `nongregorian-diary-listing-hook',
`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
These hooks have the following distinct roles:

    `nongregorian-diary-listing-hook' can cull dates from the diary
        and each included file.  Usually used for Hebrew or Islamic
        diary entries in files.  Applied to *each* file.

    `list-diary-entries-hook' adds or manipulates diary entries from
        external sources.  Used, for example, to include diary entries
        from other files or to sort the diary entries.  Invoked *once* only,
        before the display hook is run.

    `diary-display-hook' does the actual display of information.  If this is
        nil, simple-diary-display will be used.  Use add-hook to set this to
        fancy-diary-display, if desired.  If you want no diary display, use
        add-hook to set this to ignore.

    `diary-hook' is run last.  This can be used for an appointment
        notification function."

  (if (< 0 number)
      (let ((original-date date);; save for possible use in the hooks
            old-diary-syntax-table
            diary-entries-list
            file-glob-attrs
            (date-string (calendar-date-string date))
            (d-file (substitute-in-file-name diary-file)))
        (message "Preparing diary...")
        (save-excursion
          (let ((diary-buffer (find-buffer-visiting d-file)))
            (if (not diary-buffer)
                (set-buffer (find-file-noselect d-file t))
              (set-buffer diary-buffer)
              (or (verify-visited-file-modtime diary-buffer)
                  (revert-buffer t t))))
          (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
          (setq selective-display t)
          (setq selective-display-ellipses nil)
          (setq old-diary-syntax-table (syntax-table))
          (set-syntax-table diary-syntax-table)
          (unwind-protect
              (toggle-read-only -1)
            (let ((buffer-read-only nil)
                  (diary-modified (buffer-modified-p))
                  (mark (regexp-quote diary-nonmarking-symbol)))
              ;; First and last characters must be ^M or \n for
              ;; selective display to work properly
              (goto-char (1- (point-max)))
              (if (not (looking-at "\^M\\|\n"))
                  (progn
                    (goto-char (point-max))
                    (insert "\^M")))
              (goto-char (point-min))
              (if (not (looking-at "\^M\\|\n"))
                  (insert "\^M"))
              (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
              (calendar-for-loop i from 1 to number do
                 (let ((d diary-date-forms)
                       (month (extract-calendar-month date))
                       (day (extract-calendar-day date))
                       (year (extract-calendar-year date))
                       (entry-found (list-sexp-diary-entries date)))
                   (while d
                     (let*
                          ((date-form (if (equal (car (car d)) 'backup)
                                          (cdr (car d))
                                        (car d)))
                          (backup (equal (car (car d)) 'backup))
                          (dayname
                           (format "%s\\|%s\\.?"
                            (calendar-day-name date)
                            (calendar-day-name date 1)))
                            ;; (calendar-day-name date 'abbrev)))
                          (monthname
                           (format "\\*\\|%s\\|%s\\.?"
                            (calendar-month-name month)
                            (calendar-month-name month 1)))
                            ;; (calendar-month-name month 'abbrev)))
                          (month (concat "\\*\\|0*" (int-to-string month)))
                          (day (concat "\\*\\|0*" (int-to-string day)))
                          (year
                           (concat
                            "\\*\\|0*" (int-to-string year)
                            (if abbreviated-calendar-year
                                (concat "\\|" (format "%02d" (% year 100)))
                              "")))
                          (regexp
                           (concat
                            "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
                            (mapconcat 'eval date-form "\\)\\(")
                            "\\)"))
                          (case-fold-search t))
                       (goto-char (point-min))
                       (while (re-search-forward regexp nil t)
                         (if backup (re-search-backward "\\<" nil t))
                         (if (and (or (char-equal (preceding-char) ?\^M)
                                      (char-equal (preceding-char) ?\n))
                                  (not (looking-at " \\|\^I")))
                             ;;  Diary entry that consists only of date.
                             (backward-char 1)
                           ;; Found a nonempty diary entry--make it visible and
                           ;; add it to the list.
                           (setq entry-found t)
                           (let ((entry-start (point))
                                 date-start temp)
                             (re-search-backward "\^M\\|\n\\|\\`")
                             (setq date-start (point))
                             (re-search-forward "\^M\\|\n" nil t 2)
                             (while (looking-at " \\|\^I")
                               (re-search-forward "\^M\\|\n" nil t))
                             (backward-char 1)
                             (subst-char-in-region date-start
                                (point) ?\^M ?\n t)
                             (setq entry (buffer-substring entry-start (point))
                                   temp (diary-pull-attrs entry file-glob-attrs)
                                   entry (nth 0 temp))
                             (add-to-diary-list
                              date
                              entry
                              (buffer-substring
                               (1+ date-start) (1- entry-start))
                              (copy-marker entry-start) (nth 1 temp))))))
                     (setq d (cdr d)))
                   (or entry-found
                       (not diary-list-include-blanks)
                       (setq diary-entries-list
                             (append diary-entries-list
                                     (list (list date "" "" "" "")))))
                   (setq date
                         (calendar-gregorian-from-absolute
                           (1+ (calendar-absolute-from-gregorian date))))
                   (setq entry-found nil)))
              (set-buffer-modified-p diary-modified))
          (set-syntax-table old-diary-syntax-table))
        (goto-char (point-min))
        (run-hooks 'nongregorian-diary-listing-hook
                   'list-diary-entries-hook)
        (if diary-display-hook
            (run-hooks 'diary-display-hook)
          ;; FIXME Error if calendar-setup 'calendar-only -- gm.
          (simple-diary-display))
        (run-hooks 'diary-hook)
        diary-entries-list))))


(provide 'diary-private)