code.delx.au - gnu-emacs/blob - 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   (make-diary-entry
 151    (format "%s(diary-cyclic %d %s)"
 152            sexp-diary-entry-symbol
 153            (calendar-read "Repeat every how many days: "
 154                           '(lambda (x) (> x 0)))
 155            (calendar-date-string
 156             (or (calendar-cursor-to-date)
 157                 (error "Cursor is not on a date!"))
 158             nil t))
 159    arg))
 160
 161 (defun insert-hebrew-diary-entry (arg)
 162   "Insert a diary entry.
 163 For the Hebrew date corresponding to the date indicated by point.
 164 Prefix arg will make the entry nonmarking."
 165   (interactive "P")
 166   (let* ((calendar-month-name-array
 167           calendar-hebrew-month-name-array-leap-year))
 168     (make-diary-entry
 169      (concat
 170       hebrew-diary-entry-symbol
 171       (calendar-date-string
 172        (calendar-hebrew-from-absolute
 173         (calendar-absolute-from-gregorian
 174          (or (calendar-cursor-to-date)
 175              (error "Cursor is not on a date!"))))
 176        nil t))
 177      arg)))
 178
 179 (defun insert-monthly-hebrew-diary-entry (arg)
 180   "Insert a monthly diary entry.
 181 For the day of the Hebrew month corresponding to the date indicated by point.
 182 Prefix arg will make the entry nonmarking."
 183   (interactive "P")
 184   (let* ((calendar-date-display-form
 185           (if european-calendar-style '(day " * ") '("* " day )))
 186          (calendar-month-name-array
 187           calendar-hebrew-month-name-array-leap-year))
 188     (make-diary-entry
 189      (concat
 190       hebrew-diary-entry-symbol
 191       (calendar-date-string
 192        (calendar-hebrew-from-absolute
 193         (calendar-absolute-from-gregorian
 194          (or (calendar-cursor-to-date)
 195              (error "Cursor is not on a date!"))))))
 196      arg)))
 197
 198 (defun insert-yearly-hebrew-diary-entry (arg)
 199   "Insert an annual diary entry.
 200 For the day of the Hebrew year corresponding to the date indicated by point.
 201 Prefix arg will make the entry nonmarking."
 202   (interactive "P")
 203   (let* ((calendar-date-display-form
 204           (if european-calendar-style
 205               '(day " " monthname)
 206             '(monthname " " day)))
 207          (calendar-month-name-array
 208           calendar-hebrew-month-name-array-leap-year))
 209     (make-diary-entry
 210      (concat
 211       hebrew-diary-entry-symbol
 212       (calendar-date-string
 213        (calendar-hebrew-from-absolute
 214         (calendar-absolute-from-gregorian
 215          (or (calendar-cursor-to-date)
 216              (error "Cursor is not on a date!"))))))
 217      arg)))
 218
 219 (defun insert-islamic-diary-entry (arg)
 220   "Insert a diary entry.
 221 For the Islamic date corresponding to the date indicated by point.
 222 Prefix arg will make the entry nonmarking."
 223   (interactive "P")
 224   (let* ((calendar-month-name-array calendar-islamic-month-name-array))
 225     (make-diary-entry
 226      (concat
 227       islamic-diary-entry-symbol
 228       (calendar-date-string
 229        (calendar-islamic-from-absolute
 230         (calendar-absolute-from-gregorian
 231          (or (calendar-cursor-to-date)
 232              (error "Cursor is not on a date!"))))
 233        nil t))
 234      arg)))
 235
 236 (defun insert-monthly-islamic-diary-entry (arg)
 237   "Insert a monthly diary entry.
 238 For the day of the Islamic month corresponding to the date indicated by point.
 239 Prefix arg will make the entry nonmarking."
 240   (interactive "P")
 241   (let* ((calendar-date-display-form
 242           (if european-calendar-style '(day " * ") '("* " day )))
 243          (calendar-month-name-array calendar-islamic-month-name-array))
 244     (make-diary-entry
 245      (concat
 246       islamic-diary-entry-symbol
 247       (calendar-date-string
 248        (calendar-islamic-from-absolute
 249         (calendar-absolute-from-gregorian
 250          (or (calendar-cursor-to-date)
 251              (error "Cursor is not on a date!"))))))
 252      arg)))
 253
 254 (defun insert-yearly-islamic-diary-entry (arg)
 255   "Insert an annual diary entry.
 256 For the day of the Islamic year corresponding to the date indicated by point.
 257 Prefix arg will make the entry nonmarking."
 258   (interactive "P")
 259   (let* ((calendar-date-display-form
 260           (if european-calendar-style
 261               '(day " " monthname)
 262             '(monthname " " day)))
 263          (calendar-month-name-array calendar-islamic-month-name-array))
 264     (make-diary-entry
 265      (concat
 266       islamic-diary-entry-symbol
 267       (calendar-date-string
 268        (calendar-islamic-from-absolute
 269         (calendar-absolute-from-gregorian
 270          (or (calendar-cursor-to-date)
 271              (error "Cursor is not on a date!"))))))
 272      arg)))
 273
 274 (provide 'diary-ins)
 275
 276 ;;; diary-ins.el ends here