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