lisp/diary-ins.el

   1 ;;; diary-insert.el --- calendar functions for adding diary entries.
   2
   3 ;; Copyright (C) 1990 Free Software Foundation, Inc.
   4
   5 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
   6 ;; Keywords: diary, calendar
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY.  No author or distributor
  12 ;; accepts responsibility to anyone for the consequences of using it
  13 ;; or for whether it serves any particular purpose or works at all,
  14 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  15 ;; License for full details.
  16
  17 ;; Everyone is granted permission to copy, modify and redistribute
  18 ;; GNU Emacs, but only under the conditions described in the
  19 ;; GNU Emacs General Public License.   A copy of this license is
  20 ;; supposed to have been given to you along with GNU Emacs so you
  21 ;; can know your rights and responsibilities.  It should be in a
  22 ;; file named COPYING.  Among other things, the copyright notice
  23 ;; and this notice must be preserved on all copies.
  24
  25 ;;; Commentary:
  26
  27 ;; This collection of functions implements the diary insertion features as
  28 ;; described in calendar.el.
  29
  30 ;; Comments, corrections, and improvements should be sent to
  31 ;;  Edward M. Reingold               Department of Computer Science
  32 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  33 ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  34 ;;                                   Urbana, Illinois 61801
  35
  36 ;;; Code:
  37
  38 (require 'diary)
  39
  40 (defun make-diary-entry (string &optional nonmarking file)
  41   "Insert a diary entry STRING which may be NONMARKING in FILE.
  42 If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
  43   (find-file-other-window
  44    (substitute-in-file-name (if file file diary-file)))
  45   (goto-char (point-max))
  46   (insert
  47    (if (bolp) "" "\n")
  48    (if nonmarking diary-nonmarking-symbol "")
  49    string " "))
  50
  51 (defun insert-diary-entry (arg)
  52   "Insert a diary entry for the date indicated by point.
  53 Prefix arg will make the entry nonmarking."
  54   (interactive "P")
  55   (make-diary-entry
  56    (calendar-date-string
  57     (or (calendar-cursor-to-date)
  58         (error "Cursor is not on a date!"))
  59     t t)
  60    arg))
  61
  62 (defun insert-weekly-diary-entry (arg)
  63   "Insert a weekly diary entry for the day of the week indicated by point.
  64 Prefix arg will make the entry nonmarking."
  65   (interactive "P")
  66   (make-diary-entry
  67    (calendar-day-name
  68     (or (calendar-cursor-to-date)
  69         (error "Cursor is not on a date!")))
  70    arg))
  71
  72 (defun insert-monthly-diary-entry (arg)
  73   "Insert a monthly diary entry for the day of the month indicated by point.
  74 Prefix arg will make the entry nonmarking."
  75   (interactive "P")
  76   (let* ((calendar-date-display-form
  77           (if european-calendar-style
  78               '(day " * ")
  79             '("* " day))))
  80     (make-diary-entry
  81      (calendar-date-string
  82       (or (calendar-cursor-to-date)
  83           (error "Cursor is not on a date!"))
  84       t)
  85      arg)))
  86
  87 (defun insert-yearly-diary-entry (arg)
  88   "Insert an annual diary entry for the day of the year indicated by point.
  89 Prefix arg will make the entry nonmarking."
  90   (interactive "P")
  91   (let* ((calendar-date-display-form
  92           (if european-calendar-style
  93               '(day " " monthname)
  94             '(monthname " " day))))
  95     (make-diary-entry
  96      (calendar-date-string
  97       (or (calendar-cursor-to-date)
  98           (error "Cursor is not on a date!"))
  99       t)
 100      arg)))
 101
 102 (defun insert-anniversary-diary-entry (arg)
 103   "Insert an anniversary diary entry for the date given by point.
 104 Prefix arg will make the entry nonmarking."
 105   (interactive "P")
 106   (make-diary-entry
 107    (format "%s(diary-anniversary %s)"
 108            sexp-diary-entry-symbol
 109            (calendar-date-string
 110             (or (calendar-cursor-to-date)
 111                 (error "Cursor is not on a date!"))
 112             nil t))
 113    arg))
 114
 115 (defun insert-block-diary-entry (arg)
 116   "Insert a block diary entry for the days between the point and marked date.
 117 Prefix arg will make the entry nonmarking."
 118   (interactive "P")
 119   (let* ((cursor (or (calendar-cursor-to-date)
 120                      (error "Cursor is not on a date!")))
 121          (mark (or (car calendar-mark-ring)
 122                    (error "No mark set in this buffer")))
 123          (start)
 124          (end))
 125     (if (< (calendar-absolute-from-gregorian mark)
 126            (calendar-absolute-from-gregorian cursor))
 127         (setq start mark
 128               end cursor)
 129       (setq start cursor
 130               end mark))
 131     (make-diary-entry
 132      (format "%s(diary-block %s %s)"
 133       sexp-diary-entry-symbol
 134       (calendar-date-string start nil t)
 135       (calendar-date-string end nil t))
 136      arg)))
 137
 138 (defun insert-cyclic-diary-entry (arg)
 139   "Insert a cyclic diary entry starting at the date given by point.
 140 Prefix arg will make the entry nonmarking."
 141   (interactive "P")
 142   (make-diary-entry
 143    (format "%s(diary-cyclic %d %s)"
 144            sexp-diary-entry-symbol
 145            (calendar-read "Repeat every how many days: "
 146                           '(lambda (x) (> x 0)))
 147            (calendar-date-string
 148             (or (calendar-cursor-to-date)
 149                 (error "Cursor is not on a date!"))
 150             nil t))
 151    arg))
 152
 153 (defun insert-hebrew-diary-entry (arg)
 154   "Insert a diary entry.
 155 For the Hebrew date corresponding to the date indicated by point.
 156 Prefix arg will make the entry nonmarking."
 157   (interactive "P")
 158   (let* ((calendar-month-name-array
 159           calendar-hebrew-month-name-array-leap-year))
 160     (make-diary-entry
 161      (concat
 162       hebrew-diary-entry-symbol
 163       (calendar-date-string
 164        (calendar-hebrew-from-absolute
 165         (calendar-absolute-from-gregorian
 166          (or (calendar-cursor-to-date)
 167              (error "Cursor is not on a date!"))))
 168        nil t))
 169      arg)))
 170
 171 (defun insert-monthly-hebrew-diary-entry (arg)
 172   "Insert a monthly diary entry.
 173 For the day of the Hebrew month corresponding to the date indicated by point.
 174 Prefix arg will make the entry nonmarking."
 175   (interactive "P")
 176   (let* ((calendar-date-display-form
 177           (if european-calendar-style '(day " * ") '("* " day )))
 178          (calendar-month-name-array
 179           calendar-hebrew-month-name-array-leap-year))
 180     (make-diary-entry
 181      (concat
 182       hebrew-diary-entry-symbol
 183       (calendar-date-string
 184        (calendar-hebrew-from-absolute
 185         (calendar-absolute-from-gregorian
 186          (or (calendar-cursor-to-date)
 187              (error "Cursor is not on a date!"))))))
 188      arg)))
 189
 190 (defun insert-yearly-hebrew-diary-entry (arg)
 191   "Insert an annual diary entry.
 192 For the day of the Hebrew year corresponding to the date indicated by point.
 193 Prefix arg will make the entry nonmarking."
 194   (interactive "P")
 195   (let* ((calendar-date-display-form
 196           (if european-calendar-style
 197               '(day " " monthname)
 198             '(monthname " " day)))
 199          (calendar-month-name-array
 200           calendar-hebrew-month-name-array-leap-year))
 201     (make-diary-entry
 202      (concat
 203       hebrew-diary-entry-symbol
 204       (calendar-date-string
 205        (calendar-hebrew-from-absolute
 206         (calendar-absolute-from-gregorian
 207          (or (calendar-cursor-to-date)
 208              (error "Cursor is not on a date!"))))))
 209      arg)))
 210
 211 (defun insert-islamic-diary-entry (arg)
 212   "Insert a diary entry.
 213 For the Islamic date corresponding to the date indicated by point.
 214 Prefix arg will make the entry nonmarking."
 215   (interactive "P")
 216   (let* ((calendar-month-name-array calendar-islamic-month-name-array))
 217     (make-diary-entry
 218      (concat
 219       islamic-diary-entry-symbol
 220       (calendar-date-string
 221        (calendar-islamic-from-absolute
 222         (calendar-absolute-from-gregorian
 223          (or (calendar-cursor-to-date)
 224              (error "Cursor is not on a date!"))))
 225        nil t))
 226      arg)))
 227
 228 (defun insert-monthly-islamic-diary-entry (arg)
 229   "Insert a monthly diary entry.
 230 For the day of the Islamic month corresponding to the date indicated by point.
 231 Prefix arg will make the entry nonmarking."
 232   (interactive "P")
 233   (let* ((calendar-date-display-form
 234           (if european-calendar-style '(day " * ") '("* " day )))
 235          (calendar-month-name-array calendar-islamic-month-name-array))
 236     (make-diary-entry
 237      (concat
 238       islamic-diary-entry-symbol
 239       (calendar-date-string
 240        (calendar-islamic-from-absolute
 241         (calendar-absolute-from-gregorian
 242          (or (calendar-cursor-to-date)
 243              (error "Cursor is not on a date!"))))))
 244      arg)))
 245
 246 (defun insert-yearly-islamic-diary-entry (arg)
 247   "Insert an annual diary entry.
 248 For the day of the Islamic year corresponding to the date indicated by point.
 249 Prefix arg will make the entry nonmarking."
 250   (interactive "P")
 251   (let* ((calendar-date-display-form
 252           (if european-calendar-style
 253               '(day " " monthname)
 254             '(monthname " " day)))
 255          (calendar-month-name-array calendar-islamic-month-name-array))
 256     (make-diary-entry
 257      (concat
 258       islamic-diary-entry-symbol
 259       (calendar-date-string
 260        (calendar-islamic-from-absolute
 261         (calendar-absolute-from-gregorian
 262          (or (calendar-cursor-to-date)
 263              (error "Cursor is not on a date!"))))))
 264      arg)))
 265
 266 (provide 'diary-insert)
 267
 268 ;;; diary-insert.el ends here