Mercurial > hg > xemacs

comparison diary.el @ 78:0abfe9bf83a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Thu, 25 Sep 2025 17:57:05 +0100
parents 800f0f595127
children
comparison
equal deleted inserted replaced
77:62fb1a21629a 78:0abfe9bf83a0
1 ;; Last edited: Wed Oct 24 17:08:20 1990
2 ;; provide a simple diary facility on top of rmailsum
3 ;; Copyright (C) 1990 Henry S. Thompson
4
5 ;; This file is part of GNU Emacs.
6
7 ;; GNU Emacs is distributed in the hope that it will be useful,
8 ;; but WITHOUT ANY WARRANTY. No author or distributor
9 ;; accepts responsibility to anyone for the consequences of using it
10 ;; or for whether it serves any particular purpose or works at all,
11 ;; unless he says so in writing. Refer to the GNU Emacs General Public
12 ;; License for full details.
13
14 ;; Everyone is granted permission to copy, modify and redistribute
15 ;; GNU Emacs, but only under the conditions described in the
16 ;; GNU Emacs General Public License. A copy of this license is
17 ;; supposed to have been given to you along with GNU Emacs so you
18 ;; can know your rights and responsibilities. It should be in a
19 ;; file named COPYING. Among other things, the copyright notice
20 ;; and this notice must be preserved on all copies.
21
22 (provide 'diary)
23 (require 'mail-extras)
24
25 (autoload 'sort-subr "sort")
26
27 (defvar ht-diary-file-name "~/DIARY.babyl"
28 "default name of diary file")
29
30 (defvar ht-Calendar-directory "~/Calendar")
31
32 (defun xxx-date-lessp (date1 date2)
33 "Return T if DATE1 is earlyer than DATE2."
34 (string-lessp (gnus-comparable-date date1)
35 (gnus-comparable-date date2)))
36
37 (defun xxx-comparable-date (date)
38 "Make comparable string by string-lessp from DATE."
39 (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
40 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
41 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
42 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
43 (date (or date "")))
44 ;; Can understand the following styles:
45 ;; (1) 14 Apr 89 03:20:12 GMT
46 ;; (2) Fri, 17 March 89 4:01:33 GMT
47 (if (string-match
48 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) *\\([0-9:]*\\)" date)
49 (let ((year (substring date (match-beginning 3) (match-end 3)))
50 (mn (substring date
51 (match-beginning 2)
52 (+ 3 (match-beginning 2))))
53 (day (substring date
54 (match-beginning 1) (match-end 1)))
55 (time (substring date (match-beginning 4) (match-end 4))))
56 (concat
57 ;; Year
58 (if (= (length year) 2)
59 (if (string-match "^9" year)
60 (concat "19" year)
61 (concat "20" year))
62 year)
63 ;; Month
64 (cdr
65 (assoc
66 (upcase mn)
67 month))
68 ;; Day
69 (format "%2d" (string-to-int day))
70 ;; Time
71 time))
72 ;; Cannot understand DATE string.
73 date
74 )
75 ))
76
77 (defun update-default-diary (arg) "update a diary - with arg, the one for
78 this file. Without arg, the default (named in ht-diary-file-name)"
79 (interactive "P")
80 (if arg
81 (update-diary (current-buffer))
82 (require-diary)
83 (update-diary (get-file-buffer ht-diary-file-name))))
84
85 (defun update-diary (buffer)
86 ;; (setq rmail-summary-buffer (get-buffer-create "*Diary*"))
87 (let ((obuf (current-buffer)))
88 (set-buffer buffer)
89 (if (not has-diary-summary)
90 (progn (make-local-variable 'has-diary-summary)
91 (setq has-diary-summary t)))
92 (rmail-summary)
93 (set-buffer obuf)))
94
95 (defun do-diary-update () "rmail-summary-mode-hook calls this"
96 (if (save-excursion (set-buffer rbuf)
97 has-diary-summary)
98 (progn
99 (make-local-variable 'diary-summary-buffer)
100 (setq diary-summary-buffer t)
101 (setq description (concat "Diary " description))
102 (setq buffer-read-only nil)
103 (sort-diary-hdrs)
104 (format-diary-hdrs)
105 (setq buffer-read-only t)
106 (not-modified)
107 (beginning-of-buffer)
108 (setq mesg nil) ; to go to earliest, not first in file
109 )))
110
111 (defun require-diary ()
112 (if (not (get-file-buffer ht-diary-file-name))
113 (progn (rmail-input ht-diary-file-name)
114 (rmail-show-message 1))
115 ))
116
117 (defvar diary-summary-buffer nil "flag to identify diary summaries")
118 (defvar has-diary-summary nil "flag to identify buffers with diary summaries")
119
120 (defun sort-diary-hdrs ()
121 (interactive)
122 (goto-char (point-min))
123 (sort-subr nil 'forward-line 'end-of-line 'get-diary-hdr-date nil))
124
125 (defun format-diary-hdrs ()
126 (goto-char (point-min))
127 (while (< (point)(point-max))
128 (forward-char 5)
129 (delete-char 35)
130 (looking-at " *\\([0-9]*\\) *\\([a-zA-Z]*\\) *\\([0-9]*\\) *\\([0-9]*\\)")
131 (if (match-beginning 0)
132 (let ((day (buffer-substring (match-beginning 1)(match-end 1)))
133 (month (capitalize (buffer-substring (match-beginning 2)
134 (min (+ (match-beginning 2)
135 3)
136 (match-end 2)))))
137 (year (buffer-substring (max
138 (- (match-end 3) 2)
139 (match-beginning 3))
140 (match-end 3)))
141 (time (buffer-substring (match-beginning 4)(match-end 4))))
142 (delete-char (+ 1
143 (if (= (match-end 4)
144 (match-beginning 4))
145 0 ; fix for no time case
146 1)
147 (- (match-end 4)(match-beginning 1))))
148 (insert (format " %2s %3s %2s %4s " day month year time))))
149 (forward-line 1))
150 (goto-char (point-min)))
151
152 (defun get-diary-hdr-date ()
153 (looking-at " *[^ ]* *[^ ]* *[^ ]* *\\(.*\\)$")
154 (xxx-comparable-date (buffer-substring (match-beginning 1)(match-end 1))))
155
156
157 (if (not (boundp 'rmail-edit-map))
158 (load-library "rmailedit"))
159 (if (not (boundp 'rmail-summary-mode-map))
160 (progn (load-library "rmailsum")
161 (rmail-summary-mode-fun1)))
162 (define-key rmail-edit-map "\C-c\C-c" 'ht-rmail-cease-edit)
163 (define-key rmail-edit-map "\C-c\C-]" 'ht-rmail-abort-edit)
164 ;(defvar diary-mode-map (copy-keymap rmail-summary-mode-map))
165 ;(define-key diary-mode-map "s" 'diary-save)
166 (define-key rmail-mode-map "h" 'ht-rmail-summarise)
167 (setq rmail-summary-mode-hook 'do-diary-update)
168
169 (defvar editing-diary-entry nil)
170
171 (defun diary-save ()
172 "save parent file and update"
173 (interactive)
174 (set-buffer rmail-buffer)
175 (rmail-expunge-and-save)
176 (if has-diary-summary (update-diary (current-buffer))))
177
178 (defun ht-rmail-summarise ()
179 "Display a summary of all messages, one line per message.
180 If file is named as ht-diary-file-name, or the summary buffer is already
181 a diary summary, make it a Diary summary (see
182 \\[describe-mode] rmail-summary-mode for info)."
183 (interactive)
184 (if (eq (current-buffer)
185 (get-file-buffer ht-diary-file-name))
186 (update-default-diary t)
187 (rmail-summary)))
188
189 (defun edit-and-move-to-diary ()
190 "try to add a date to subject field, move to diary on exit"
191 (interactive)
192 (make-local-variable 'editing-diary-entry)
193 (setq editing-diary-entry t)
194 (rmail-edit-current-message)
195 (goto-char (point-min))
196 (search-forward "\n\n")
197 (let ((try-date (and
198 (re-search-forward
199 "[0-9][-0-9 ]*[- ][a-zA-Z][a-zA-Z]*[- 0-9]*" nil t)
200 (buffer-substring (match-beginning 0)(match-end 0))))
201 sublp)
202 (goto-char (point-min))
203 (setq sublp (search-forward "Subject: " nil t))
204 (if try-date
205 (progn (set-mark (point))
206 (insert try-date)))))
207
208 (defun gnus-edit-and-move-to-diary (&optional arg)
209 "try to add a date to subject field if not already there,
210 move to diary on exit,
211 delete if n is absent,
212 move immediately w/o editing if marked.
213 Repeat for subsequent marked, if any"
214 (interactive "P")
215 (set-buffer gnus-summary-buffer)
216 (let* ((n (if arg (prefix-numeric-value arg)))
217 (no-delete (and n (> n 0)))
218 (neg (and n (< n 0)))
219 (no-edit (or gnus-newsgroup-processable neg)))
220 (let ((articles (gnus-summary-work-articles
221 (cond
222 (neg (- n))
223 (gnus-newsgroup-processable nil)
224 (t 1))))
225 article)
226 (when (and (not no-edit)
227 (/= (length articles) 1))
228 (error "Editting multiple articles for diary not implemented yet"))
229 (while (setq article (pop articles))
230 (gnus-edit-and-move-to-diary_1 no-delete no-edit)
231 (when (memq article gnus-newsgroup-processable)
232 (gnus-summary-remove-process-mark article)))
233 (if (and no-edit (not (gnus-summary-next-unread-article)))
234 (gnus-summary-exit)))
235 ))
236
237 (defun gnus-edit-and-move-to-diary_1 (no-delete no-edit)
238 "try to add a date to subject field if not already there,
239 move to diary on exit,
240 delete if not no-delete, move immediately w/o editing if no-edit"
241 (let ((flush-shell nil))
242 (when (and (not (and no-delete no-edit))
243 (gnus-group-read-only-p))
244 (error "The current newsgroup does not support article editing"))
245 ;; Select article if needed.
246 (unless (eq (gnus-summary-article-number)
247 gnus-current-article)
248 (gnus-summary-select-article t))
249 (gnus-article-date-original)
250 (message "About to forward. . .")
251 (gnus-summary-mail-forward 1)
252 (message "Begin forward. . .")
253 (goto-char (point-min))
254 (re-search-forward "^To: " nil t)
255 ;(forward-char 4)
256 (insert "htcalendar@markup.co.uk")
257 (search-forward "------ Start of forwarded")
258 (save-excursion
259 (when (and (bufferp (get-buffer "*Shell Command Output*"))
260 (not (re-search-forward
261 "^--0000.*[[:space:]]*Content-Type: text/plain" nil t nil
262 (get-buffer " *Original Article*")))
263 (search-forward "<html" nil t))
264 (backward-char 5)
265 (push-mark nil t)
266 (re-search-forward "</html>[[:space:]]*")
267 (exchange-point-and-mark)
268 (use-text-not-html t)
269 (let ((pos (point)))
270 (when (search-backward "type=text/html" nil t)
271 (replace-match "type=text/plain")
272 (goto-char (+ pos 1))))
273 (setq flush-shell t)
274 ))
275 (let (sublp)
276 (save-excursion
277 (goto-char (point-min))
278 (setq sublp (search-forward "Subject: " nil t))
279 (delete-region (point)(progn (search-forward "] " nil t)))
280 (if (not
281 (looking-at "[123]?[0-9] [JFMASOND][a-z][a-z] (20)?[2-9][0-9] "))
282 (save-excursion
283 (let ((try-date
284 (and
285 (or (re-search-forward "^\r?$" nil 1) t)
286 (re-search-forward
287 "[0-9][-0-9 ]*[- ][jfmasondJFMASOND][a-zA-Z]*[- 0-9]*"
288 (save-excursion (search-forward "\n--\n" nil t))
289 t)
290 (buffer-substring (match-beginning 0)(match-end 0)))))
291 (message (format "date: |%s| %s" try-date sublp))
292 (if (and sublp
293 try-date)
294 (progn (set-mark (point))
295 (insert try-date)))))))
296 (make-local-hook 'message-send-hook)
297 (if no-edit
298 (let ((hook `(lambda ()
299 (ht-gnus-cease-edit ,no-delete))))
300 (add-hook 'message-send-hook hook nil t)
301 (message-send-and-exit))
302 (add-hook 'message-send-hook
303 `(lambda ()
304 (ht-gnus-cease-edit ',no-delete ',flush-shell))
305 nil t)
306 (split-window-vertically 6)
307 (other-window 1)
308 (search-forward "\n\n" nil t)
309 (other-window 1)
310 (goto-char sublp)
311 (message "Exiting to buffer, we hope")))
312 )
313 )
314
315 (defun ht-gnus-cease-edit (&optional no-delete flush-shell)
316 "check if diary edit, move if so"
317 (interactive "P")
318 (message "ceasing. . .")
319 (ht-forward-to-Calendar)
320 (let ((rmail-summary-redo '(rmail-summary)))
321 (gnus-output-to-rmail ht-diary-file-name)
322 )
323 (unless no-delete
324 (with-current-buffer gnus-summary-buffer
325 (gnus-summary-move-article 1 "nnml+ht:_doom")))
326 (if (get-buffer "diary.babyl-summary")
327 (kill-buffer "diary.babyl-summary"))
328 (with-current-buffer "diary.babyl"
329 (rmail-mode)
330 (save-buffer)
331 (ht-rmail-summarise))
332 (if flush-shell
333 (let ((sb (get-buffer "*Shell Command Output*")))
334 (if (bufferp sb)
335 (kill-buffer sb))))
336 (message "ceased"))
337
338 (defun ht-gnus-summary-save-in-diary (&optional filename)
339 (gnus-eval-in-buffer-window gnus-save-article-buffer
340 (save-excursion
341 (save-restriction
342 (widen)
343 (gnus-output-to-rmail ht-diary-file-name)))))
344
345 ;; private copy to simulate hook
346 (defun ht-rmail-cease-edit ()
347 "check if diary edit, move if so"
348 (interactive)
349 (rmail-cease-edit)
350 (if editing-diary-entry
351 (progn (setq editing-diary-entry nil)
352 (ht-forward-to-Calendar)
353 (rmail-output-to-rmail-file ht-diary-file-name 1)
354 (ht-rmail-delete-forward))))
355
356 ;; try to add a diary subject field line to the appropriate calendar file
357 (defun ht-forward-to-Calendar ()
358 (goto-char (point-min))
359 (search-forward "Subject: ")
360 (or (looking-at
361 "\\([0-9]+\\) \\([A-Za-z]+\\) \\([0-9]+\\) \\([0-9:]*\\) ?\\(.*\\)\n")
362 (error "not a recognisable diary line"))
363 (let ((day (buffer-substring (match-beginning 1) (match-end 1)))
364 (month (buffer-substring (match-beginning 2) (match-end 2)))
365 (year (buffer-substring (match-beginning 3) (match-end 3)))
366 (time (buffer-substring (match-beginning 4) (match-end 4)))
367 (message (buffer-substring (match-beginning 5) (match-end 5)))
368 (mb (match-beginning 4))
369 (me (match-end 5))
370 ends e-day e-month fn)
371 (let ((year (if (string-match "^\\(19\\|20\\).." year)
372 year
373 (if (eq (length year) 2)
374 (concat "20" year)
375 (progn (if (and (equal time "")(eq (length year) 4))
376 (setq time year))
377 (format-time-string "%Y")))))
378 (t-month (capitalize
379 (substring month 0 3))))
380 (let* ((n-day (read day))
381 (mon-table '((Jan . 1)
382 (Feb . 2)
383 (Mar . 3)
384 (Apr . 4)
385 (May . 5)
386 (Jun . 6)
387 (Jul . 7)
388 (Aug . 8)
389 (Sep . 9)
390 (Oct . 10)
391 (Nov . 11)
392 (Dec . 12)))
393 (a-month (assq (read t-month)
394 mon-table))
395 (n-month (if a-month (cdr a-month) 0))
396 (u-time (if (equal time "") "0" time))
397 (hour (/ (read u-time) 100))
398 (minute (mod (read u-time) 100))
399 (nhour (if (> minute 29)
400 (+ 1 hour)
401 hour))
402 (nminute (if (> minute 29)
403 (- minute 30)
404 (+ minute 30)))
405 (n-year (read year))
406 (r-subj (mail-fetch-field "Subject"))
407 (body (save-excursion
408 (buffer-substring
409 (progn
410 (goto-char (point-min))
411 (if (re-search-forward "^\r?$" nil 1)
412 (match-beginning 0)
413 (point-max)))
414 (point-max))))
415 (subj-matches (string-match "^\\([^(]*\\)\\((\\(.*\\))\\)?"
416 message))
417 (np-subj (match-string 1 message))
418 (p-subj (or (match-string 3 message) ""))
419 (uid (or (mail-fetch-field "Message-id")
420 (let ((ct (current-time)))
421 (format "%d-%d-%d"
422 (car ct)
423 (cadr ct)
424 (caddr ct)))))
425 )
426 (if (string-match " -- \\(.*\\)$" message)
427 (progn
428 (setq ends (substring message (match-beginning 1)
429 (match-end 1)))
430 (setq message (substring message 0 (match-beginning 0)))
431 (if (string-match "\\([0-9]+\\) \\([A-Za-z]+\\)" ends)
432 (progn
433 (setq e-day (substring ends (match-beginning 1)
434 (match-end 1)))
435 (setq e-month (assq
436 (read (capitalize
437 (substring
438 (substring ends (match-beginning 2)
439 (match-end 2))
440 0 3)))
441 mon-table))))))
442 (setq fn (build-vcal-message (my-time-iso8601
443 (encode-time
444 0 minute
445 hour
446 n-day
447 n-month
448 n-year))
449 (my-time-iso8601
450 (if e-day
451 (encode-time
452 0 (if (eq hour 0) 30 minute) ;nminute
453 (if (eq hour 0) 23 hour) ; nhour
454 (read e-day)
455 (if e-month (cdr e-month) 0)
456 n-year)
457 (encode-time
458 0 minute ; nminute
459 (+ hour 1) ; nhour
460 n-day
461 n-month
462 n-year)))
463 "ORGANIZER;CN=\"Henry S. Thompson\":mailto:htcalendar@markup.co.uk"
464 ;(concat "ORGANIZER:" (mail-fetch-field "From"))
465 p-subj
466 body
467 np-subj
468 (concat "ht-vcal-" uid)))
469 (if fn
470 (progn
471 (goto-char (point-min))
472 (if (search-forward "<#multipart " nil t)
473 (progn
474 (if (search-forward "<#multipart type=alternative" nil t)
475 (beginning-of-line)
476 (forward-line 2)
477 ;; now at beginning of forwarded text
478 (if (search-forward "<#part " nil t)
479 (progn
480 ;; now at beginning of _attachments_
481 (beginning-of-line))
482 ;; no attachments, probably never happens
483 (search-forward "<#/multipart>"))))
484 ;; plain text, make it multipart
485 (search-forward "-------- Start of forwarded")
486 (re-search-forward "^\r?$")
487 (forward-line 1)
488 (insert "<#multipart type=mixed>\n<#part type=text/plain charset=\"ISO-8859-1\" format=\"flowed\" disposition=inline nofile=yes>\n")
489 (search-forward "--------- End of forwarded")
490 (forward-line -1)
491 (insert "<#/multipart>\n")
492 (forward-line -1))
493 (mml-attach-file fn "application/octet-stream" "diary event")
494 ; (let ((res (shell-command-to-string
495 ; (concat "updateCal.pl < " fn))))
496 ; (if (not (equal res ""))
497 ; (message (format "update losing: %s" res))))
498 )))
499 (if (file-exists-p ht-Calendar-directory)
500 (let* ((dfn (concat ht-Calendar-directory
501 "/xy"
502 year
503 "/xc"
504 day
505 t-month
506 year))
507 (buf (find-file-noselect dfn))
508 )
509 (save-excursion
510 (set-buffer buf)
511 (goto-char (point-max))
512 (if (not (bolp))
513 (insert "\n"))
514 (if time
515 (insert time " "))
516 (insert message)
517 (let ((require-final-newline nil))
518 (save-buffer)))
519 (if ends
520 ;; an end date also given
521 (if e-day
522 (let (t-e-month msg)
523 (setq msg (concat
524 (substring message 0
525 (string-match " " message))
526 " continues"))
527 (if (string-equal (setq t-e-month
528 (if e-month (car e-month)
529 t-month))
530 t-month)
531 (fill-dates year t-month (1+ (car
532 (read-from-string day)))
533 (car
534 (read-from-string e-day))
535 msg)
536 (fill-dates year t-month (1+ (car
537 (read-from-string day)))
538 (cdr (assoc t-month
539 '(("Jan" . 31)
540 ("Feb" . 28)
541 ("Mar" . 31)
542 ("Apr" . 30)
543 ("May" . 31)
544 ("Jun" . 30)
545 ("Jul" . 31)
546 ("Aug" . 31)
547 ("Sep" . 30)
548 ("Oct" . 31)
549 ("Nov" . 30)
550 ("Dec" . 31))))
551 msg)
552 (fill-dates year t-e-month 1
553 (car (read-from-string e-day))
554 msg)))
555 (message "\C-g\C-gCouldn't parse end date: %s" ends)))
556 )))))
557
558 (defun fill-dates (year month start end mesg)
559 "fill the dates between start and end with message in the calendar"
560 (let ((day start))
561 (while (<= day end)
562 (let* ((dfn (concat ht-Calendar-directory
563 "/xy"
564 year
565 "/xc"
566 (format "%d" day)
567 (format "%s" month)
568 year))
569 (buf (find-file-noselect dfn)))
570 (save-excursion
571 (set-buffer buf)
572 (goto-char (point-max))
573 (if (not (bolp))
574 (insert "\n"))
575 (insert mesg)
576 (let ((require-final-newline nil))
577 (save-buffer))))
578 (setq day (1+ day)))))
579
580 ;; private copy
581 (defun ht-rmail-abort-edit ()
582 "add a hook"
583 (interactive)
584 (setq editing-diary-entry nil)
585 (rmail-abort-edit))
586
587 (defun rmail-edit-current-message ()
588 "Edit the contents of this message."
589 (interactive)
590 (rmail-edit-mode)
591 (make-local-variable 'rmail-old-text)
592 (setq rmail-old-text (buffer-substring (point-min) (point-max)))
593 (setq buffer-read-only nil)
594 (set-buffer-modified-p (buffer-modified-p))
595 ;; Make mode line update.
596 (if (and (eq (key-binding "\C-c\C-c") 'ht-rmail-cease-edit)
597 (eq (key-binding "\C-c\C-]") 'ht-rmail-abort-edit))
598 (if editing-diary-entry
599 (message "Editing: Type C-c C-c to move to diary and return to Rmail, C-c C-] to abort")
600 (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort"))
601 (message (substitute-command-keys
602 "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
603
604
605 (defun build-vcal-message (start end org location description summary uid)
606 (save-excursion
607 (let ((fn (concat "/tmp/" (make-temp-name "vcal") ".ics")))
608 (find-file fn)
609 ;\nMETHOD:PUBLISH
610 (insert "BEGIN:VCALENDAR\nVERSION:1.0\nPRODID:-//Henry S. Thompson//gnus diary hack//EN\nBEGIN:VEVENT\n")
611 (insert "UID:")(insert uid)(insert "\n")
612 (insert "DTSTAMP:")(insert
613 (my-time-iso8601 (current-time)))
614 (insert "Z\n")
615 (insert "DTSTART:")(insert start)(insert "Z\n")
616 (insert "DTEND:")(insert end)(insert "Z\n")
617 (insert "SUMMARY:")(insert-encoded-maybe summary)(insert "\n")
618 (insert "DESCRIPTION")(insert-folded description)
619 ; (insert "LOCATION")(insert-encoded-maybe location)(insert "\n")
620 ;(insert "ORGANIZER")(insert-encoded-maybe org)
621 ; (insert org)
622 ; (insert "\n")
623 ; (insert "BEGIN:VALARM\nTRIGGER:-PT15M\nACTION:DISPLAY\nDESCRIPTION:Reminder\nEND:VALARM\n")
624 ; (insert "BEGIN:VALARM\nTRIGGER:-PT15M\nACTION:AUDIO\nDESCRIPTION:Reminder\nEND:VALARM\n")
625 (insert "END:VEVENT\nEND:VCALENDAR\n")
626 (save-buffer)
627 fn)))
628
629 (defun insert-encoded-maybe (string)
630 (if (string-match "[\000-\007\n\013\015-\037\200-\377=]" string)
631 (progn
632 (insert ";ENCODING=QUOTED-PRINTABLE:")
633 (let ((beg (point)))
634 (insert string)
635 (message (format "%d;%d" beg (point)))
636 (quoted-printable-encode-region
637 beg
638 (point)
639 t
640 "^\000-\007\n\013\015-\037\200-\377="))
641 (goto-char (point-max)))
642 (insert "\n :")
643 (insert string)))
644
645 (defun insert-folded (string)
646 (insert "\n :")
647 (let ((beg (point)))
648 (insert string)
649 (narrow-to-region beg (point))
650 (goto-char (point-min))
651 (replace-string "\n" "\\n")
652 (goto-char (point-min))
653 (replace-string "\r" "")
654 (goto-char (point-min))
655 (replace-string "," "\\,")
656 (goto-char (point-min))
657 (while (> (- (point-max) (point)) 72)
658 (forward-char 70)
659 (insert "\n "))
660 (goto-char (point-max))
661 (insert "\r\n")
662 (widen)))
663
664 (defun my-time-iso8601 (time)
665 (let ((tzo (car (current-time-zone time)))
666 (hi (car time))
667 (lo (cadr time))
668 (ignore (cddr time)))
669 (gnus-time-iso8601
670 (if (>= lo tzo)
671 (cons hi
672 (cons (- lo tzo)
673 ignore))
674 (cons (- hi 1)
675 (cons (- (+ lo 65536) tzo)
676 ignore)))
677 )))