home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / calendar / diary-insert.el < prev    next >
Encoding:
Text File  |  1993-03-14  |  9.3 KB  |  271 lines
  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.   (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 for the Hebrew date corresponding to the date
  163. indicated by point.  Prefix arg will make the entry nonmarking."
  164.   (interactive "P")
  165.   (let* ((calendar-month-name-array
  166.           calendar-hebrew-month-name-array-leap-year))
  167.     (make-diary-entry
  168.      (concat
  169.       hebrew-diary-entry-symbol
  170.       (calendar-date-string 
  171.        (calendar-hebrew-from-absolute
  172.         (calendar-absolute-from-gregorian
  173.          (or (calendar-cursor-to-date)
  174.              (error "Cursor is not on a date!"))))
  175.        nil t))
  176.      arg)))
  177.  
  178. (defun insert-monthly-hebrew-diary-entry (arg)
  179.   "Insert a monthly diary entry for the day of the Hebrew month corresponding
  180. to the date indicated by point.  Prefix arg will make the entry nonmarking."
  181.   (interactive "P")
  182.   (let* ((calendar-date-display-form
  183.           (if european-calendar-style '(day " * ") '("* " day )))
  184.          (calendar-month-name-array
  185.           calendar-hebrew-month-name-array-leap-year))
  186.     (make-diary-entry
  187.      (concat
  188.       hebrew-diary-entry-symbol
  189.       (calendar-date-string 
  190.        (calendar-hebrew-from-absolute
  191.         (calendar-absolute-from-gregorian
  192.          (or (calendar-cursor-to-date)
  193.              (error "Cursor is not on a date!"))))))
  194.      arg)))
  195.  
  196. (defun insert-yearly-hebrew-diary-entry (arg)
  197.   "Insert an annual diary entry for the day of the Hebrew year corresponding
  198. to the date indicated by point.  Prefix arg will make the entry nonmarking."
  199.   (interactive "P")
  200.   (let* ((calendar-date-display-form
  201.           (if european-calendar-style
  202.               '(day " " monthname)
  203.             '(monthname " " day)))
  204.          (calendar-month-name-array
  205.           calendar-hebrew-month-name-array-leap-year))
  206.     (make-diary-entry
  207.      (concat
  208.       hebrew-diary-entry-symbol
  209.       (calendar-date-string 
  210.        (calendar-hebrew-from-absolute
  211.         (calendar-absolute-from-gregorian
  212.          (or (calendar-cursor-to-date)
  213.              (error "Cursor is not on a date!"))))))
  214.      arg)))
  215.  
  216. (defun insert-islamic-diary-entry (arg)
  217.   "Insert a diary entry for the Islamic date corresponding to the date
  218. indicated by point.  Prefix arg will make the entry nonmarking."
  219.   (interactive "P")
  220.   (let* ((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.          (or (calendar-cursor-to-date)
  228.              (error "Cursor is not on a date!"))))
  229.        nil t))
  230.      arg)))
  231.  
  232. (defun insert-monthly-islamic-diary-entry (arg)
  233.   "Insert a monthly diary entry for the day of the Islamic month corresponding
  234. to the date indicated by point.  Prefix arg will make the entry nonmarking."
  235.   (interactive "P")
  236.   (let* ((calendar-date-display-form
  237.           (if european-calendar-style '(day " * ") '("* " day )))
  238.          (calendar-month-name-array calendar-islamic-month-name-array))
  239.     (make-diary-entry
  240.      (concat
  241.       islamic-diary-entry-symbol
  242.       (calendar-date-string 
  243.        (calendar-islamic-from-absolute
  244.         (calendar-absolute-from-gregorian
  245.          (or (calendar-cursor-to-date)
  246.              (error "Cursor is not on a date!"))))))
  247.      arg)))
  248.  
  249. (defun insert-yearly-islamic-diary-entry (arg)
  250.   "Insert an annual diary entry for the day of the Islamic year corresponding
  251. to the date indicated by point.  Prefix arg will make the entry nonmarking."
  252.   (interactive "P")
  253.   (let* ((calendar-date-display-form
  254.           (if european-calendar-style
  255.               '(day " " monthname)
  256.             '(monthname " " day)))
  257.          (calendar-month-name-array calendar-islamic-month-name-array))
  258.     (make-diary-entry
  259.      (concat
  260.       islamic-diary-entry-symbol
  261.       (calendar-date-string 
  262.        (calendar-islamic-from-absolute
  263.         (calendar-absolute-from-gregorian
  264.          (or (calendar-cursor-to-date)
  265.              (error "Cursor is not on a date!"))))))
  266.      arg)))
  267.  
  268. (provide 'diary-insert)
  269.  
  270. ;;; diary-insert.el ends here
  271.