--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/calendar/diary-ins.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,251 @@
+;;; diary-ins.el --- calendar functions for adding diary entries.
+
+;; Copyright (C) 1990, 1994 Free Software Foundation, Inc.
+
+;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Keywords: diary, calendar
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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, or (at your option)
+;; any later version.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;; This collection of functions implements the diary insertion features as
+;; described in calendar.el.
+
+;; Comments, corrections, and improvements should be sent to
+;;  Edward M. Reingold               Department of Computer Science
+;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
+;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
+;;                                   Urbana, Illinois 61801
+
+;;; Code:
+
+(require 'diary-lib)
+
+(defun make-diary-entry (string &optional nonmarking file)
+  "Insert a diary entry STRING which may be NONMARKING in FILE.
+If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
+  (find-file-other-window
+   (substitute-in-file-name (if file file diary-file)))
+  (goto-char (point-max))
+  (insert
+   (if (bolp) "" "\n")
+   (if nonmarking diary-nonmarking-symbol "")
+   string " "))
+
+(defun insert-diary-entry (arg)
+  "Insert a diary entry for the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
+                    arg))
+
+(defun insert-weekly-diary-entry (arg)
+  "Insert a weekly diary entry for the day of the week indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
+                    arg))
+
+(defun insert-monthly-diary-entry (arg)
+  "Insert a monthly diary entry for the day of the month indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " * ")
+            '("* " day))))
+    (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
+                      arg)))
+
+(defun insert-yearly-diary-entry (arg)
+  "Insert an annual diary entry for the day of the year indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " monthname)
+            '(monthname " " day))))
+    (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
+                      arg)))
+
+(defun insert-anniversary-diary-entry (arg)
+  "Insert an anniversary diary entry for the date given by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " month " " year)
+            '(month " " day " " year))))
+    (make-diary-entry
+     (format "%s(diary-anniversary %s)"
+             sexp-diary-entry-symbol
+             (calendar-date-string (calendar-cursor-to-date t) nil t))
+     arg)))
+
+(defun insert-block-diary-entry (arg)
+  "Insert a block diary entry for the days between the point and marked date.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " month " " year)
+            '(month " " day " " year)))
+         (cursor (calendar-cursor-to-date t))
+         (mark (or (car calendar-mark-ring)
+                   (error "No mark set in this buffer")))
+         (start)
+         (end))
+    (if (< (calendar-absolute-from-gregorian mark)
+           (calendar-absolute-from-gregorian cursor))
+        (setq start mark
+              end cursor)
+      (setq start cursor
+              end mark))
+    (make-diary-entry
+     (format "%s(diary-block %s %s)"
+      sexp-diary-entry-symbol
+      (calendar-date-string start nil t)
+      (calendar-date-string end nil t))
+     arg)))
+
+(defun insert-cyclic-diary-entry (arg)
+  "Insert a cyclic diary entry starting at the date given by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " month " " year)
+            '(month " " day " " year))))
+    (make-diary-entry
+     (format "%s(diary-cyclic %d %s)"
+             sexp-diary-entry-symbol
+             (calendar-read "Repeat every how many days: "
+                            '(lambda (x) (> x 0)))
+             (calendar-date-string (calendar-cursor-to-date t) nil t))
+     arg)))
+
+(defun insert-hebrew-diary-entry (arg)
+  "Insert a diary entry.
+For the Hebrew date corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-month-name-array
+          calendar-hebrew-month-name-array-leap-year))
+    (make-diary-entry
+     (concat
+      hebrew-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-hebrew-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))
+       nil t))
+     arg)))
+
+(defun insert-monthly-hebrew-diary-entry (arg)
+  "Insert a monthly diary entry.
+For the day of the Hebrew month corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style '(day " * ") '("* " day )))
+         (calendar-month-name-array
+          calendar-hebrew-month-name-array-leap-year))
+    (make-diary-entry
+     (concat
+      hebrew-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-hebrew-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))))
+     arg)))
+
+(defun insert-yearly-hebrew-diary-entry (arg)
+  "Insert an annual diary entry.
+For the day of the Hebrew year corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " monthname)
+            '(monthname " " day)))
+         (calendar-month-name-array
+          calendar-hebrew-month-name-array-leap-year))
+    (make-diary-entry
+     (concat
+      hebrew-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-hebrew-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))))
+     arg)))
+
+(defun insert-islamic-diary-entry (arg)
+  "Insert a diary entry.
+For the Islamic date corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-month-name-array calendar-islamic-month-name-array))
+    (make-diary-entry
+     (concat
+      islamic-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-islamic-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))
+       nil t))
+     arg)))
+
+(defun insert-monthly-islamic-diary-entry (arg)
+  "Insert a monthly diary entry.
+For the day of the Islamic month corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style '(day " * ") '("* " day )))
+         (calendar-month-name-array calendar-islamic-month-name-array))
+    (make-diary-entry
+     (concat
+      islamic-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-islamic-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))))
+     arg)))
+
+(defun insert-yearly-islamic-diary-entry (arg)
+  "Insert an annual diary entry.
+For the day of the Islamic year corresponding to the date indicated by point.
+Prefix arg will make the entry nonmarking."
+  (interactive "P")
+  (let* ((calendar-date-display-form
+          (if european-calendar-style
+              '(day " " monthname)
+            '(monthname " " day)))
+         (calendar-month-name-array calendar-islamic-month-name-array))
+    (make-diary-entry
+     (concat
+      islamic-diary-entry-symbol
+      (calendar-date-string 
+       (calendar-islamic-from-absolute
+        (calendar-absolute-from-gregorian
+         (calendar-cursor-to-date t)))))
+     arg)))
+
+(provide 'diary-ins)
+
+;;; diary-ins.el ends here