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, 1994 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 (calendar-date-string (calendar-cursor-to-date t) t t)
  56                     arg))
  57
  58 (defun insert-weekly-diary-entry (arg)
  59   "Insert a weekly diary entry for the day of the week indicated by point.
  60 Prefix arg will make the entry nonmarking."
  61   (interactive "P")
  62   (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
  63                     arg))
  64
  65 (defun insert-monthly-diary-entry (arg)
  66   "Insert a monthly diary entry for the day of the month indicated by point.
  67 Prefix arg will make the entry nonmarking."
  68   (interactive "P")
  69   (let* ((calendar-date-display-form
  70           (if european-calendar-style
  71               '(day " * ")
  72             '("* " day))))
  73     (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
  74                       arg)))
  75
  76 (defun insert-yearly-diary-entry (arg)
  77   "Insert an annual diary entry for the day of the year indicated by point.
  78 Prefix arg will make the entry nonmarking."
  79   (interactive "P")
  80   (let* ((calendar-date-display-form
  81           (if european-calendar-style
  82               '(day " " monthname)
  83             '(monthname " " day))))
  84     (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
  85                       arg)))
  86
  87 (defun insert-anniversary-diary-entry (arg)
  88   "Insert an anniversary diary entry for the date given 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 " " month " " year)
  94             '(month " " day " " year))))
  95     (make-diary-entry
  96      (format "%s(diary-anniversary %s)"
  97              sexp-diary-entry-symbol
  98              (calendar-date-string (calendar-cursor-to-date t) nil t))
  99      arg)))
 100
 101 (defun insert-block-diary-entry (arg)
 102   "Insert a block diary entry for the days between the point and marked date.
 103 Prefix arg will make the entry nonmarking."
 104   (interactive "P")
 105   (let* ((calendar-date-display-form
 106           (if european-calendar-style
 107               '(day " " month " " year)
 108             '(month " " day " " year)))
 109          (cursor (calendar-cursor-to-date t))
 110          (mark (or (car calendar-mark-ring)
 111                    (error "No mark set in this buffer")))
 112          (start)
 113          (end))
 114     (if (< (calendar-absolute-from-gregorian mark)
 115            (calendar-absolute-from-gregorian cursor))
 116         (setq start mark
 117               end cursor)
 118       (setq start cursor
 119               end mark))
 120     (make-diary-entry
 121      (format "%s(diary-block %s %s)"
 122       sexp-diary-entry-symbol
 123       (calendar-date-string start nil t)
 124       (calendar-date-string end nil t))
 125      arg)))
 126
 127 (defun insert-cyclic-diary-entry (arg)
 128   "Insert a cyclic diary entry starting at the date given by point.
 129 Prefix arg will make the entry nonmarking."
 130   (interactive "P")
 131   (let* ((calendar-date-display-form
 132           (if european-calendar-style
 133               '(day " " month " " year)
 134             '(month " " day " " year))))
 135     (make-diary-entry
 136      (format "%s(diary-cyclic %d %s)"
 137              sexp-diary-entry-symbol
 138              (calendar-read "Repeat every how many days: "
 139                             '(lambda (x) (> x 0)))
 140              (calendar-date-string (calendar-cursor-to-date t) nil t))
 141      arg)))
 142
 143 (defun insert-hebrew-diary-entry (arg)
 144   "Insert a diary entry.
 145 For the Hebrew date corresponding to the date indicated by point.
 146 Prefix arg will make the entry nonmarking."
 147   (interactive "P")
 148   (let* ((calendar-month-name-array
 149           calendar-hebrew-month-name-array-leap-year))
 150     (make-diary-entry
 151      (concat
 152       hebrew-diary-entry-symbol
 153       (calendar-date-string
 154        (calendar-hebrew-from-absolute
 155         (calendar-absolute-from-gregorian
 156          (calendar-cursor-to-date t)))
 157        nil t))
 158      arg)))
 159
 160 (defun insert-monthly-hebrew-diary-entry (arg)
 161   "Insert a monthly diary entry.
 162 For the day of the Hebrew month corresponding to the date indicated by point.
 163 Prefix arg will make the entry nonmarking."
 164   (interactive "P")
 165   (let* ((calendar-date-display-form
 166           (if european-calendar-style '(day " * ") '("* " day )))
 167          (calendar-month-name-array
 168           calendar-hebrew-month-name-array-leap-year))
 169     (make-diary-entry
 170      (concat
 171       hebrew-diary-entry-symbol
 172       (calendar-date-string
 173        (calendar-hebrew-from-absolute
 174         (calendar-absolute-from-gregorian
 175          (calendar-cursor-to-date t)))))
 176      arg)))
 177
 178 (defun insert-yearly-hebrew-diary-entry (arg)
 179   "Insert an annual diary entry.
 180 For the day of the Hebrew year corresponding to the date indicated by point.
 181 Prefix arg will make the entry nonmarking."
 182   (interactive "P")
 183   (let* ((calendar-date-display-form
 184           (if european-calendar-style
 185               '(day " " monthname)
 186             '(monthname " " day)))
 187          (calendar-month-name-array
 188           calendar-hebrew-month-name-array-leap-year))
 189     (make-diary-entry
 190      (concat
 191       hebrew-diary-entry-symbol
 192       (calendar-date-string
 193        (calendar-hebrew-from-absolute
 194         (calendar-absolute-from-gregorian
 195          (calendar-cursor-to-date t)))))
 196      arg)))
 197
 198 (defun insert-islamic-diary-entry (arg)
 199   "Insert a diary entry.
 200 For the Islamic date corresponding to the date indicated by point.
 201 Prefix arg will make the entry nonmarking."
 202   (interactive "P")
 203   (let* ((calendar-month-name-array calendar-islamic-month-name-array))
 204     (make-diary-entry
 205      (concat
 206       islamic-diary-entry-symbol
 207       (calendar-date-string
 208        (calendar-islamic-from-absolute
 209         (calendar-absolute-from-gregorian
 210          (calendar-cursor-to-date t)))
 211        nil t))
 212      arg)))
 213
 214 (defun insert-monthly-islamic-diary-entry (arg)
 215   "Insert a monthly diary entry.
 216 For the day of the Islamic month corresponding to the date indicated by point.
 217 Prefix arg will make the entry nonmarking."
 218   (interactive "P")
 219   (let* ((calendar-date-display-form
 220           (if european-calendar-style '(day " * ") '("* " day )))
 221          (calendar-month-name-array calendar-islamic-month-name-array))
 222     (make-diary-entry
 223      (concat
 224       islamic-diary-entry-symbol
 225       (calendar-date-string
 226        (calendar-islamic-from-absolute
 227         (calendar-absolute-from-gregorian
 228          (calendar-cursor-to-date t)))))
 229      arg)))
 230
 231 (defun insert-yearly-islamic-diary-entry (arg)
 232   "Insert an annual diary entry.
 233 For the day of the Islamic year corresponding to the date indicated by point.
 234 Prefix arg will make the entry nonmarking."
 235   (interactive "P")
 236   (let* ((calendar-date-display-form
 237           (if european-calendar-style
 238               '(day " " monthname)
 239             '(monthname " " day)))
 240          (calendar-month-name-array calendar-islamic-month-name-array))
 241     (make-diary-entry
 242      (concat
 243       islamic-diary-entry-symbol
 244       (calendar-date-string
 245        (calendar-islamic-from-absolute
 246         (calendar-absolute-from-gregorian
 247          (calendar-cursor-to-date t)))))
 248      arg)))
 249
 250 (provide 'diary-ins)
 251
 252 ;;; diary-ins.el ends here