lisp/diary-ins.el

   1 ;;; diary-ins.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   (let* ((calendar-date-display-form
 107           (if european-calendar-style
 108               '(day " " month " " year)
 109             '(month " " day " " year))))
 110     (make-diary-entry
 111      (format "%s(diary-anniversary %s)"
 112              sexp-diary-entry-symbol
 113              (calendar-date-string
 114               (or (calendar-cursor-to-date)
 115                   (error "Cursor is not on a date!"))
 116               nil t))
 117      arg)))
 118
 119 (defun insert-block-diary-entry (arg)
 120   "Insert a block diary entry for the days between the point and marked date.
 121 Prefix arg will make the entry nonmarking."
 122   (interactive "P")
 123   (let* ((calendar-date-display-form
 124           (if european-calendar-style
 125               '(day " " month " " year)
 126             '(month " " day " " year)))
 127          (cursor (or (calendar-cursor-to-date)
 128                      (error "Cursor is not on a date!")))
 129          (mark (or (car calendar-mark-ring)
 130                    (error "No mark set in this buffer")))
 131          (start)
 132          (end))
 133     (if (< (calendar-absolute-from-gregorian mark)
 134            (calendar-absolute-from-gregorian cursor))
 135         (setq start mark
 136               end cursor)
 137       (setq start cursor
 138               end mark))
 139     (make-diary-entry
 140      (format "%s(diary-block %s %s)"
 141       sexp-diary-entry-symbol
 142       (calendar-date-string start nil t)
 143       (calendar-date-string end nil t))
 144      arg)))
 145
 146 (defun insert-cyclic-diary-entry (arg)
 147   "Insert a cyclic diary entry starting at the date given by point.
 148 Prefix arg will make the entry nonmarking."
 149   (interactive "P")
 150   (let* ((calendar-date-display-form
 151           (if european-calendar-style
 152               '(day " " month " " year)
 153             '(month " " day " " year))))
 154     (make-diary-entry
 155      (format "%s(diary-cyclic %d %s)"
 156              sexp-diary-entry-symbol
 157              (calendar-read "Repeat every how many days: "
 158                             '(lambda (x) (> x 0)))
 159              (calendar-date-string
 160               (or (calendar-cursor-to-date)
 161                   (error "Cursor is not on a date!"))
 162               nil t))
 163      arg)))
 164
 165 (defun insert-hebrew-diary-entry (arg)
 166   "Insert a diary entry.
 167 For the Hebrew date corresponding to the date indicated by point.
 168 Prefix arg will make the entry nonmarking."
 169   (interactive "P")
 170   (let* ((calendar-month-name-array
 171           calendar-hebrew-month-name-array-leap-year))
 172     (make-diary-entry
 173      (concat
 174       hebrew-diary-entry-symbol
 175       (calendar-date-string
 176        (calendar-hebrew-from-absolute
 177         (calendar-absolute-from-gregorian
 178          (or (calendar-cursor-to-date)
 179              (error "Cursor is not on a date!"))))
 180        nil t))
 181      arg)))
 182
 183 (defun insert-monthly-hebrew-diary-entry (arg)
 184   "Insert a monthly diary entry.
 185 For the day of the Hebrew month corresponding to the date indicated by point.
 186 Prefix arg will make the entry nonmarking."
 187   (interactive "P")
 188   (let* ((calendar-date-display-form
 189           (if european-calendar-style '(day " * ") '("* " day )))
 190          (calendar-month-name-array
 191           calendar-hebrew-month-name-array-leap-year))
 192     (make-diary-entry
 193      (concat
 194       hebrew-diary-entry-symbol
 195       (calendar-date-string
 196        (calendar-hebrew-from-absolute
 197         (calendar-absolute-from-gregorian
 198          (or (calendar-cursor-to-date)
 199              (error "Cursor is not on a date!"))))))
 200      arg)))
 201
 202 (defun insert-yearly-hebrew-diary-entry (arg)
 203   "Insert an annual diary entry.
 204 For the day of the Hebrew year corresponding to the date indicated by point.
 205 Prefix arg will make the entry nonmarking."
 206   (interactive "P")
 207   (let* ((calendar-date-display-form
 208           (if european-calendar-style
 209               '(day " " monthname)
 210             '(monthname " " day)))
 211          (calendar-month-name-array
 212           calendar-hebrew-month-name-array-leap-year))
 213     (make-diary-entry
 214      (concat
 215       hebrew-diary-entry-symbol
 216       (calendar-date-string
 217        (calendar-hebrew-from-absolute
 218         (calendar-absolute-from-gregorian
 219          (or (calendar-cursor-to-date)
 220              (error "Cursor is not on a date!"))))))
 221      arg)))
 222
 223 (defun insert-islamic-diary-entry (arg)
 224   "Insert a diary entry.
 225 For the Islamic date corresponding to the date indicated by point.
 226 Prefix arg will make the entry nonmarking."
 227   (interactive "P")
 228   (let* ((calendar-month-name-array calendar-islamic-month-name-array))
 229     (make-diary-entry
 230      (concat
 231       islamic-diary-entry-symbol
 232       (calendar-date-string
 233        (calendar-islamic-from-absolute
 234         (calendar-absolute-from-gregorian
 235          (or (calendar-cursor-to-date)
 236              (error "Cursor is not on a date!"))))
 237        nil t))
 238      arg)))
 239
 240 (defun insert-monthly-islamic-diary-entry (arg)
 241   "Insert a monthly diary entry.
 242 For the day of the Islamic month corresponding to the date indicated by point.
 243 Prefix arg will make the entry nonmarking."
 244   (interactive "P")
 245   (let* ((calendar-date-display-form
 246           (if european-calendar-style '(day " * ") '("* " day )))
 247          (calendar-month-name-array calendar-islamic-month-name-array))
 248     (make-diary-entry
 249      (concat
 250       islamic-diary-entry-symbol
 251       (calendar-date-string
 252        (calendar-islamic-from-absolute
 253         (calendar-absolute-from-gregorian
 254          (or (calendar-cursor-to-date)
 255              (error "Cursor is not on a date!"))))))
 256      arg)))
 257
 258 (defun insert-yearly-islamic-diary-entry (arg)
 259   "Insert an annual diary entry.
 260 For the day of the Islamic year corresponding to the date indicated by point.
 261 Prefix arg will make the entry nonmarking."
 262   (interactive "P")
 263   (let* ((calendar-date-display-form
 264           (if european-calendar-style
 265               '(day " " monthname)
 266             '(monthname " " day)))
 267          (calendar-month-name-array calendar-islamic-month-name-array))
 268     (make-diary-entry
 269      (concat
 270       islamic-diary-entry-symbol
 271       (calendar-date-string
 272        (calendar-islamic-from-absolute
 273         (calendar-absolute-from-gregorian
 274          (or (calendar-cursor-to-date)
 275              (error "Cursor is not on a date!"))))))
 276      arg)))
 277
 278 (provide 'diary-ins)
 279
 280 ;;; diary-ins.el ends here