home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / a2.0bemacs-src.lha / Emacs-19.25 / lisp / diary-ins.el < prev    next >
Encoding:
Text File  |  1994-04-08  |  8.7 KB  |  252 lines
  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)
  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
  252.