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