Mercurial > hg > xemacs-beta

comparison lisp/calendar/diary-ins.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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 XEmacs.
9
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; 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