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 free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; This collection of functions implements the diary insertion features as
  27 ;; described in calendar.el.
  28
  29 ;; Comments, corrections, and improvements should be sent to
  30 ;;  Edward M. Reingold               Department of Computer Science
  31 ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  32 ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  33 ;;                                   Urbana, Illinois 61801
  34
  35 ;;; Code:
  36
  37 (require 'diary-lib)
  38
  39 (defun make-diary-entry (string &optional nonmarking file)
  40   "Insert a diary entry STRING which may be NONMARKING in FILE.
  41 If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
  42   (find-file-other-window
  43    (substitute-in-file-name (if file file diary-file)))
  44   (goto-char (point-max))
  45   (insert
  46    (if (bolp) "" "\n")
  47    (if nonmarking diary-nonmarking-symbol "")
  48    string " "))
  49
  50 (defun insert-diary-entry (arg)
  51   "Insert a diary entry for the date indicated by point.
  52 Prefix arg will make the entry nonmarking."
  53   (interactive "P")
  54   (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
  55                     arg))
  56
  57 (defun insert-weekly-diary-entry (arg)
  58   "Insert a weekly diary entry for the day of the week indicated by point.
  59 Prefix arg will make the entry nonmarking."
  60   (interactive "P")
  61   (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
  62                     arg))
  63
  64 (defun insert-monthly-diary-entry (arg)
  65   "Insert a monthly diary entry for the day of the month indicated by point.
  66 Prefix arg will make the entry nonmarking."
  67   (interactive "P")
  68   (let* ((calendar-date-display-form
  69           (if european-calendar-style
  70               '(day " * ")
  71             '("* " day))))
  72     (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
  73                       arg)))
  74
  75 (defun insert-yearly-diary-entry (arg)
  76   "Insert an annual diary entry for the day of the year indicated by point.
  77 Prefix arg will make the entry nonmarking."
  78   (interactive "P")
  79   (let* ((calendar-date-display-form
  80           (if european-calendar-style
  81               '(day " " monthname)
  82             '(monthname " " day))))
  83     (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
  84                       arg)))
  85
  86 (defun insert-anniversary-diary-entry (arg)
  87   "Insert an anniversary diary entry for the date given by point.
  88 Prefix arg will make the entry nonmarking."
  89   (interactive "P")
  90   (let* ((calendar-date-display-form
  91           (if european-calendar-style
  92               '(day " " month " " year)
  93             '(month " " day " " year))))
  94     (make-diary-entry
  95      (format "%s(diary-anniversary %s)"
  96              sexp-diary-entry-symbol
  97              (calendar-date-string (calendar-cursor-to-date t) nil t))
  98      arg)))
  99
 100 (defun insert-block-diary-entry (arg)
 101   "Insert a block diary entry for the days between the point and marked date.
 102 Prefix arg will make the entry nonmarking."
 103   (interactive "P")
 104   (let* ((calendar-date-display-form
 105           (if european-calendar-style
 106               '(day " " month " " year)
 107             '(month " " day " " year)))
 108          (cursor (calendar-cursor-to-date t))
 109          (mark (or (car calendar-mark-ring)
 110                    (error "No mark set in this buffer")))
 111          (start)
 112          (end))
 113     (if (< (calendar-absolute-from-gregorian mark)
 114            (calendar-absolute-from-gregorian cursor))
 115         (setq start mark
 116               end cursor)
 117       (setq start cursor
 118               end mark))
 119     (make-diary-entry
 120      (format "%s(diary-block %s %s)"
 121       sexp-diary-entry-symbol
 122       (calendar-date-string start nil t)
 123       (calendar-date-string end nil t))
 124      arg)))
 125
 126 (defun insert-cyclic-diary-entry (arg)
 127   "Insert a cyclic diary entry starting at the date given by point.
 128 Prefix arg will make the entry nonmarking."
 129   (interactive "P")
 130   (let* ((calendar-date-display-form
 131           (if european-calendar-style
 132               '(day " " month " " year)
 133             '(month " " day " " year))))
 134     (make-diary-entry
 135      (format "%s(diary-cyclic %d %s)"
 136              sexp-diary-entry-symbol
 137              (calendar-read "Repeat every how many days: "
 138                             '(lambda (x) (> x 0)))
 139              (calendar-date-string (calendar-cursor-to-date t) nil t))
 140      arg)))
 141
 142 (defun insert-hebrew-diary-entry (arg)
 143   "Insert a diary entry.
 144 For the Hebrew date corresponding to the date indicated by point.
 145 Prefix arg will make the entry nonmarking."
 146   (interactive "P")
 147   (let* ((calendar-month-name-array
 148           calendar-hebrew-month-name-array-leap-year))
 149     (make-diary-entry
 150      (concat
 151       hebrew-diary-entry-symbol
 152       (calendar-date-string
 153        (calendar-hebrew-from-absolute
 154         (calendar-absolute-from-gregorian
 155          (calendar-cursor-to-date t)))
 156        nil t))
 157      arg)))
 158
 159 (defun insert-monthly-hebrew-diary-entry (arg)
 160   "Insert a monthly diary entry.
 161 For the day of the Hebrew month corresponding to the date indicated by point.
 162 Prefix arg will make the entry nonmarking."
 163   (interactive "P")
 164   (let* ((calendar-date-display-form
 165           (if european-calendar-style '(day " * ") '("* " day )))
 166          (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          (calendar-cursor-to-date t)))))
 175      arg)))
 176
 177 (defun insert-yearly-hebrew-diary-entry (arg)
 178   "Insert an annual diary entry.
 179 For the day of the Hebrew year corresponding to the date indicated by point.
 180 Prefix arg will make the entry nonmarking."
 181   (interactive "P")
 182   (let* ((calendar-date-display-form
 183           (if european-calendar-style
 184               '(day " " monthname)
 185             '(monthname " " 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          (calendar-cursor-to-date t)))))
 195      arg)))
 196
 197 (defun insert-islamic-diary-entry (arg)
 198   "Insert a diary entry.
 199 For the Islamic date corresponding to the date indicated by point.
 200 Prefix arg will make the entry nonmarking."
 201   (interactive "P")
 202   (let* ((calendar-month-name-array calendar-islamic-month-name-array))
 203     (make-diary-entry
 204      (concat
 205       islamic-diary-entry-symbol
 206       (calendar-date-string
 207        (calendar-islamic-from-absolute
 208         (calendar-absolute-from-gregorian
 209          (calendar-cursor-to-date t)))
 210        nil t))
 211      arg)))
 212
 213 (defun insert-monthly-islamic-diary-entry (arg)
 214   "Insert a monthly diary entry.
 215 For the day of the Islamic month corresponding to the date indicated by point.
 216 Prefix arg will make the entry nonmarking."
 217   (interactive "P")
 218   (let* ((calendar-date-display-form
 219           (if european-calendar-style '(day " * ") '("* " day )))
 220          (calendar-month-name-array calendar-islamic-month-name-array))
 221     (make-diary-entry
 222      (concat
 223       islamic-diary-entry-symbol
 224       (calendar-date-string
 225        (calendar-islamic-from-absolute
 226         (calendar-absolute-from-gregorian
 227          (calendar-cursor-to-date t)))))
 228      arg)))
 229
 230 (defun insert-yearly-islamic-diary-entry (arg)
 231   "Insert an annual diary entry.
 232 For the day of the Islamic year corresponding to the date indicated by point.
 233 Prefix arg will make the entry nonmarking."
 234   (interactive "P")
 235   (let* ((calendar-date-display-form
 236           (if european-calendar-style
 237               '(day " " monthname)
 238             '(monthname " " day)))
 239          (calendar-month-name-array calendar-islamic-month-name-array))
 240     (make-diary-entry
 241      (concat
 242       islamic-diary-entry-symbol
 243       (calendar-date-string
 244        (calendar-islamic-from-absolute
 245         (calendar-absolute-from-gregorian
 246          (calendar-cursor-to-date t)))))
 247      arg)))
 248
 249 (provide 'diary-ins)
 250
 251 ;;; diary-ins.el ends here