Mercurial > emacs
comparison lisp/calendar/diary-lib.el @ 90237:aa89c814f853
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-88
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 569-579)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 129-132)
- Update from CVS
- Merge from emacs--cvs-trunk--0
author | Miles Bader <miles@gnu.org> |
---|---|
date | Fri, 07 Oct 2005 07:15:40 +0000 |
parents | ee12d75eb214 8c8c651e39cc |
children | 5e2d3828e89f |
comparison
equal
deleted
inserted
replaced
90236:7871ecd1281b | 90237:aa89c814f853 |
---|---|
269 | 269 |
270 | 270 |
271 ;; This can be removed once the kill/yank treatment of invisible text | 271 ;; This can be removed once the kill/yank treatment of invisible text |
272 ;; (see etc/TODO) is fixed. -- gm | 272 ;; (see etc/TODO) is fixed. -- gm |
273 (defcustom diary-header-line-flag t | 273 (defcustom diary-header-line-flag t |
274 "*If non-nil, `simple-diary-display' will show a header line. | 274 "If non-nil, `diary-simple-display' will show a header line. |
275 The format of the header is specified by `diary-header-line-format'." | 275 The format of the header is specified by `diary-header-line-format'." |
276 :group 'diary | 276 :group 'diary |
277 :type 'boolean | 277 :type 'boolean |
278 :version "22.1") | 278 :version "22.1") |
279 | 279 |
280 (defvar diary-selective-display nil) | |
281 | |
280 (defcustom diary-header-line-format | 282 (defcustom diary-header-line-format |
281 '(:eval (calendar-string-spread | 283 '(:eval (calendar-string-spread |
282 (list (if selective-display | 284 (list (if diary-selective-display |
283 "Selective display active - press \"s\" in calendar \ | 285 "Selective display active - press \"s\" in calendar \ |
284 before edit/copy" | 286 before edit/copy" |
285 "Diary")) | 287 "Diary")) |
286 ?\s (frame-width))) | 288 ?\s (frame-width))) |
287 "*Format of the header line displayed by `simple-diary-display'. | 289 "Format of the header line displayed by `diary-simple-display'. |
288 Only used if `diary-header-line-flag' is non-nil." | 290 Only used if `diary-header-line-flag' is non-nil." |
289 :group 'diary | 291 :group 'diary |
290 :type 'sexp | 292 :type 'sexp |
291 :version "22.1") | 293 :version "22.1") |
292 | 294 |
320 (integer :tag "Friday") | 322 (integer :tag "Friday") |
321 (integer :tag "Saturday"))) | 323 (integer :tag "Saturday"))) |
322 :group 'diary) | 324 :group 'diary) |
323 | 325 |
324 (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) | 326 (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) |
325 (defun diary-list-entries (date number) | 327 (defun diary-list-entries (date number &optional list-only) |
326 "Create and display a buffer containing the relevant lines in `diary-file'. | 328 "Create and display a buffer containing the relevant lines in `diary-file'. |
327 The arguments are DATE and NUMBER; the entries selected are those | 329 The arguments are DATE and NUMBER; the entries selected are those |
328 for NUMBER days starting with date DATE. The other entries are hidden | 330 for NUMBER days starting with date DATE. The other entries are hidden |
329 using selective display. If NUMBER is less than 1, this function does nothing. | 331 using selective display. If NUMBER is less than 1, this function does nothing. |
330 | 332 |
331 Returns a list of all relevant diary entries found, if any, in order by date. | 333 Returns a list of all relevant diary entries found, if any, in order by date. |
332 The list entries have the form ((month day year) string specifier) where | 334 The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where |
333 \(month day year) is the date of the entry, string is the entry text, and | 335 \(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and |
334 specifier is the applicability. If the variable `diary-list-include-blanks' | 336 SPECIFIER is the applicability. If the variable `diary-list-include-blanks' |
335 is t, this list includes a dummy diary entry consisting of the empty string) | 337 is t, this list includes a dummy diary entry consisting of the empty string |
336 for a date with no diary entries. | 338 for a date with no diary entries. |
337 | 339 |
338 After the list is prepared, the hooks `nongregorian-diary-listing-hook', | 340 After the list is prepared, the hooks `nongregorian-diary-listing-hook', |
339 `list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run. | 341 `list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run. |
340 These hooks have the following distinct roles: | 342 These hooks have the following distinct roles: |
352 nil, simple-diary-display will be used. Use add-hook to set this to | 354 nil, simple-diary-display will be used. Use add-hook to set this to |
353 fancy-diary-display, if desired. If you want no diary display, use | 355 fancy-diary-display, if desired. If you want no diary display, use |
354 add-hook to set this to ignore. | 356 add-hook to set this to ignore. |
355 | 357 |
356 `diary-hook' is run last. This can be used for an appointment | 358 `diary-hook' is run last. This can be used for an appointment |
357 notification function." | 359 notification function. |
360 | |
361 If LIST-ONLY is non-nil don't modify or display the buffer, only return a list." | |
358 (unless number | 362 (unless number |
359 (setq number (if (vectorp number-of-diary-entries) | 363 (setq number (if (vectorp number-of-diary-entries) |
360 (aref number-of-diary-entries (calendar-day-of-week date)) | 364 (aref number-of-diary-entries (calendar-day-of-week date)) |
361 number-of-diary-entries))) | 365 number-of-diary-entries))) |
362 (when (> number 0) | 366 (when (> number 0) |
371 (if (not diary-buffer) | 375 (if (not diary-buffer) |
372 (set-buffer (find-file-noselect d-file t)) | 376 (set-buffer (find-file-noselect d-file t)) |
373 (set-buffer diary-buffer) | 377 (set-buffer diary-buffer) |
374 (or (verify-visited-file-modtime diary-buffer) | 378 (or (verify-visited-file-modtime diary-buffer) |
375 (revert-buffer t t)))) | 379 (revert-buffer t t)))) |
380 ;; Setup things like the header-line-format and invisibility-spec. | |
381 (when (eq major-mode 'fundamental-mode) (diary-mode)) | |
376 ;; d-s-p is passed to the diary display function. | 382 ;; d-s-p is passed to the diary display function. |
377 (let ((diary-saved-point (point))) | 383 (let ((diary-saved-point (point))) |
378 (save-excursion | 384 (save-excursion |
379 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) | 385 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil ""))) |
380 (setq selective-display t) | |
381 (setq selective-display-ellipses nil) | |
382 (if diary-header-line-flag | |
383 (setq header-line-format diary-header-line-format)) | |
384 (with-syntax-table diary-syntax-table | 386 (with-syntax-table diary-syntax-table |
385 (let ((buffer-read-only nil) | 387 (let ((mark (regexp-quote diary-nonmarking-symbol))) |
386 (diary-modified (buffer-modified-p)) | |
387 (mark (regexp-quote diary-nonmarking-symbol))) | |
388 ;; First and last characters must be ^M or \n for | |
389 ;; selective display to work properly | |
390 (goto-char (1- (point-max))) | |
391 (if (not (looking-at "\^M\\|\n")) | |
392 (progn | |
393 (goto-char (point-max)) | |
394 (insert "\^M"))) | |
395 (goto-char (point-min)) | 388 (goto-char (point-min)) |
396 (if (not (looking-at "\^M\\|\n")) | 389 (unless list-only |
397 (insert "\^M")) | 390 (let ((ol (make-overlay (point-min) (point-max) nil t nil))) |
398 (subst-char-in-region (point-min) (point-max) ?\n ?\^M t) | 391 (set (make-local-variable 'diary-selective-display) t) |
392 (overlay-put ol 'invisible 'diary) | |
393 (overlay-put ol 'evaporate t))) | |
399 (calendar-for-loop | 394 (calendar-for-loop |
400 i from 1 to number do | 395 i from 1 to number do |
401 (let ((month (extract-calendar-month date)) | 396 (let ((month (extract-calendar-month date)) |
402 (day (extract-calendar-day date)) | 397 (day (extract-calendar-day date)) |
403 (year (extract-calendar-year date)) | 398 (year (extract-calendar-year date)) |
424 (concat "\\|" (format "%02d" (% year 100))) | 419 (concat "\\|" (format "%02d" (% year 100))) |
425 ""))) | 420 ""))) |
426 (regexp | 421 (regexp |
427 (concat | 422 (concat |
428 "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" | 423 "\\(\\`\\|\^M\\|\n\\)" mark "?\\(" |
429 (mapconcat 'eval date-form "\\)\\(") | 424 (mapconcat 'eval date-form "\\)\\(?:") |
430 "\\)")) | 425 "\\)")) |
431 (case-fold-search t)) | 426 (case-fold-search t)) |
432 (goto-char (point-min)) | 427 (goto-char (point-min)) |
433 (while (re-search-forward regexp nil t) | 428 (while (re-search-forward regexp nil t) |
434 (if backup (re-search-backward "\\<" nil t)) | 429 (if backup (re-search-backward "\\<" nil t)) |
446 (setq date-start (point)) | 441 (setq date-start (point)) |
447 (re-search-forward "\^M\\|\n" nil t 2) | 442 (re-search-forward "\^M\\|\n" nil t 2) |
448 (while (looking-at " \\|\^I") | 443 (while (looking-at " \\|\^I") |
449 (re-search-forward "\^M\\|\n" nil t)) | 444 (re-search-forward "\^M\\|\n" nil t)) |
450 (backward-char 1) | 445 (backward-char 1) |
451 (subst-char-in-region date-start | 446 (unless list-only |
452 (point) ?\^M ?\n t) | 447 (remove-overlays date-start (point) |
448 'invisible 'diary)) | |
453 (setq entry (buffer-substring entry-start (point)) | 449 (setq entry (buffer-substring entry-start (point)) |
454 temp (diary-pull-attrs entry file-glob-attrs) | 450 temp (diary-pull-attrs entry file-glob-attrs) |
455 entry (nth 0 temp)) | 451 entry (nth 0 temp)) |
456 (add-to-diary-list | 452 (add-to-diary-list |
457 date | 453 date |
465 (append diary-entries-list | 461 (append diary-entries-list |
466 (list (list date "" "" "" ""))))) | 462 (list (list date "" "" "" ""))))) |
467 (setq date | 463 (setq date |
468 (calendar-gregorian-from-absolute | 464 (calendar-gregorian-from-absolute |
469 (1+ (calendar-absolute-from-gregorian date)))) | 465 (1+ (calendar-absolute-from-gregorian date)))) |
470 (setq entry-found nil))) | 466 (setq entry-found nil))))) |
471 (set-buffer-modified-p diary-modified))) | |
472 (goto-char (point-min)) | 467 (goto-char (point-min)) |
473 (run-hooks 'nongregorian-diary-listing-hook | 468 (run-hooks 'nongregorian-diary-listing-hook |
474 'list-diary-entries-hook) | 469 'list-diary-entries-hook) |
475 (if diary-display-hook | 470 (unless list-only |
476 (run-hooks 'diary-display-hook) | 471 (if diary-display-hook |
477 (simple-diary-display)) | 472 (run-hooks 'diary-display-hook) |
473 (simple-diary-display))) | |
478 (run-hooks 'diary-hook) | 474 (run-hooks 'diary-hook) |
479 diary-entries-list)))))) | 475 diary-entries-list)))))) |
480 | 476 |
481 (defun diary-unhide-everything () | 477 (defun diary-unhide-everything () |
482 (setq selective-display nil) | 478 (kill-local-variable 'diary-selective-display) |
483 (let ((inhibit-read-only t) | 479 (remove-overlays (point-min) (point-max) 'invisible 'diary) |
484 (modified (buffer-modified-p))) | |
485 (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) | |
486 (set-buffer-modified-p modified)) | |
487 (kill-local-variable 'mode-line-format)) | 480 (kill-local-variable 'mode-line-format)) |
488 | 481 |
489 (defun include-other-diary-files () | 482 (defun include-other-diary-files () |
490 "Include the diary entries from other diary files with those of diary-file. | 483 "Include the diary entries from other diary files with those of diary-file. |
491 This function is suitable for use in `list-diary-entries-hook'; | 484 This function is suitable for use in `list-diary-entries-hook'; |
601 (goto-char (point-min)) | 594 (goto-char (point-min)) |
602 (set-buffer-modified-p nil) | 595 (set-buffer-modified-p nil) |
603 (setq buffer-read-only t) | 596 (setq buffer-read-only t) |
604 (display-buffer holiday-buffer) | 597 (display-buffer holiday-buffer) |
605 (message "No diary entries for %s" date-string))) | 598 (message "No diary entries for %s" date-string))) |
606 (save-excursion;; Prepare the fancy diary buffer. | 599 (with-current-buffer;; Prepare the fancy diary buffer. |
607 (set-buffer (make-fancy-diary-buffer)) | 600 (make-fancy-diary-buffer) |
608 (setq buffer-read-only nil) | 601 (setq buffer-read-only nil) |
609 (let ((entry-list diary-entries-list) | 602 (let ((entry-list diary-entries-list) |
610 (holiday-list) | 603 (holiday-list) |
611 (holiday-list-last-month 1) | 604 (holiday-list-last-month 1) |
612 (holiday-list-last-year 1) | 605 (holiday-list-last-year 1) |
671 (save-excursion | 664 (save-excursion |
672 (let* ((marks (nth 4 (car entry-list))) | 665 (let* ((marks (nth 4 (car entry-list))) |
673 (temp-face (make-symbol | 666 (temp-face (make-symbol |
674 (apply | 667 (apply |
675 'concat "temp-face-" | 668 'concat "temp-face-" |
676 (mapcar '(lambda (sym) | 669 (mapcar (lambda (sym) |
677 (if (stringp sym) | 670 (if (stringp sym) |
678 sym | 671 sym |
679 (symbol-name sym))) | 672 (symbol-name sym))) |
680 marks)))) | 673 marks)))) |
681 (faceinfo marks)) | 674 (faceinfo marks)) |
682 (make-face temp-face) | 675 (make-face temp-face) |
683 ;; Remove :face info from the marks, | 676 ;; Remove :face info from the marks, |
684 ;; copy the face info into temp-face | 677 ;; copy the face info into temp-face |
685 (while (setq faceinfo (memq :face faceinfo)) | 678 (while (setq faceinfo (memq :face faceinfo)) |
686 (copy-face (read (nth 1 faceinfo)) temp-face) | 679 (copy-face (read (nth 1 faceinfo)) temp-face) |
687 (setcar faceinfo nil) | 680 (setcar faceinfo nil) |
688 (setcar (cdr faceinfo) nil)) | 681 (setcar (cdr faceinfo) nil)) |
689 (setq marks (delq nil marks)) | 682 (setq marks (delq nil marks)) |
690 ;; Apply the font aspects | 683 ;; Apply the font aspects. |
691 (apply 'set-face-attribute temp-face nil marks) | 684 (apply 'set-face-attribute temp-face nil marks) |
692 (search-backward entry) | 685 (search-backward entry) |
693 (overlay-put | 686 (overlay-put |
694 (make-overlay (match-beginning 0) (match-end 0)) | 687 (make-overlay (match-beginning 0) (match-end 0)) |
695 'face temp-face))))) | 688 'face temp-face))))) |
702 (calendar-set-mode-line date-string) | 695 (calendar-set-mode-line date-string) |
703 (message "Preparing diary...done")))) | 696 (message "Preparing diary...done")))) |
704 | 697 |
705 (defun make-fancy-diary-buffer () | 698 (defun make-fancy-diary-buffer () |
706 "Create and return the initial fancy diary buffer." | 699 "Create and return the initial fancy diary buffer." |
707 (save-excursion | 700 (with-current-buffer (get-buffer-create fancy-diary-buffer) |
708 (set-buffer (get-buffer-create fancy-diary-buffer)) | |
709 (setq buffer-read-only nil) | 701 (setq buffer-read-only nil) |
710 (calendar-set-mode-line "Diary Entries") | 702 (calendar-set-mode-line "Diary Entries") |
711 (erase-buffer) | 703 (erase-buffer) |
712 (set-buffer-modified-p nil) | 704 (set-buffer-modified-p nil) |
713 (setq buffer-read-only t) | 705 (setq buffer-read-only t) |
724 | 716 |
725 The hooks given by the variable `print-diary-entries-hook' are called to do | 717 The hooks given by the variable `print-diary-entries-hook' are called to do |
726 the actual printing." | 718 the actual printing." |
727 (interactive) | 719 (interactive) |
728 (if (bufferp (get-buffer fancy-diary-buffer)) | 720 (if (bufferp (get-buffer fancy-diary-buffer)) |
729 (save-excursion | 721 (with-current-buffer (get-buffer fancy-diary-buffer) |
730 (set-buffer (get-buffer fancy-diary-buffer)) | |
731 (run-hooks 'print-diary-entries-hook)) | 722 (run-hooks 'print-diary-entries-hook)) |
732 (let ((diary-buffer | 723 (let ((diary-buffer |
733 (find-buffer-visiting (substitute-in-file-name diary-file)))) | 724 (find-buffer-visiting (substitute-in-file-name diary-file)))) |
734 (if diary-buffer | 725 (if diary-buffer |
735 (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*")) | 726 (let ((temp-buffer (get-buffer-create " *Printable Diary Entries*")) |
736 (heading)) | 727 (heading)) |
737 (save-excursion | 728 (with-current-buffer diary-buffer |
738 (set-buffer diary-buffer) | |
739 (setq heading | 729 (setq heading |
740 (if (not (stringp mode-line-format)) | 730 (if (not (stringp mode-line-format)) |
741 "All Diary Entries" | 731 "All Diary Entries" |
742 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format) | 732 (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format) |
743 (substring mode-line-format | 733 (match-string 1 mode-line-format))) |
744 (match-beginning 1) (match-end 1)))) | 734 (let ((start (point-min)) |
745 (copy-to-buffer temp-buffer (point-min) (point-max)) | 735 end) |
736 (while | |
737 (progn | |
738 (setq end (next-single-char-property-change | |
739 start 'invisible)) | |
740 (if (get-char-property start 'invisible) | |
741 nil | |
742 (with-current-buffer temp-buffer | |
743 (insert-buffer-substring diary-buffer | |
744 start (or end (point-max))))) | |
745 (setq start end) | |
746 (and end (< end (point-max)))))) | |
746 (set-buffer temp-buffer) | 747 (set-buffer temp-buffer) |
747 (while (re-search-forward "\^M.*$" nil t) | |
748 (replace-match "")) | |
749 (goto-char (point-min)) | 748 (goto-char (point-min)) |
750 (insert heading "\n" | 749 (insert heading "\n" |
751 (make-string (length heading) ?=) "\n") | 750 (make-string (length heading) ?=) "\n") |
752 (run-hooks 'print-diary-entries-hook) | 751 (run-hooks 'print-diary-entries-hook) |
753 (kill-buffer temp-buffer))) | 752 (kill-buffer temp-buffer))) |
762 (interactive) | 761 (interactive) |
763 (let ((d-file (diary-check-diary-file)) | 762 (let ((d-file (diary-check-diary-file)) |
764 (pop-up-frames (window-dedicated-p (selected-window)))) | 763 (pop-up-frames (window-dedicated-p (selected-window)))) |
765 (with-current-buffer (or (find-buffer-visiting d-file) | 764 (with-current-buffer (or (find-buffer-visiting d-file) |
766 (find-file-noselect d-file t)) | 765 (find-file-noselect d-file t)) |
766 (when (eq major-mode 'fundamental-mode) (diary-mode)) | |
767 (diary-unhide-everything) | 767 (diary-unhide-everything) |
768 (display-buffer (current-buffer))))) | 768 (display-buffer (current-buffer))))) |
769 | 769 |
770 (defcustom diary-mail-addr | 770 (defcustom diary-mail-addr |
771 (if (boundp 'user-mail-address) user-mail-address "") | 771 (if (boundp 'user-mail-address) user-mail-address "") |
772 "*Email address that `diary-mail-entries' will send email to." | 772 "Email address that `diary-mail-entries' will send email to." |
773 :group 'diary | 773 :group 'diary |
774 :type 'string | 774 :type 'string |
775 :version "20.3") | 775 :version "20.3") |
776 | 776 |
777 (defcustom diary-mail-days 7 | 777 (defcustom diary-mail-days 7 |
778 "*Default number of days for `diary-mail-entries' to check." | 778 "Default number of days for `diary-mail-entries' to check." |
779 :group 'diary | 779 :group 'diary |
780 :type 'integer | 780 :type 'integer |
781 :version "20.3") | 781 :version "20.3") |
782 | 782 |
783 ;;;###autoload | 783 ;;;###autoload |
864 (redraw-calendar)) | 864 (redraw-calendar)) |
865 (let ((marking-diary-entries t) | 865 (let ((marking-diary-entries t) |
866 file-glob-attrs marks) | 866 file-glob-attrs marks) |
867 (with-current-buffer (find-file-noselect (diary-check-diary-file) t) | 867 (with-current-buffer (find-file-noselect (diary-check-diary-file) t) |
868 (save-excursion | 868 (save-excursion |
869 (when (eq major-mode 'fundamental-mode) (diary-mode)) | |
869 (setq mark-diary-entries-in-calendar t) | 870 (setq mark-diary-entries-in-calendar t) |
870 (message "Marking diary entries...") | 871 (message "Marking diary entries...") |
871 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) | 872 (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) |
872 (with-syntax-table diary-syntax-table | 873 (with-syntax-table diary-syntax-table |
873 (dolist (date-form diary-date-forms) | 874 (dolist (date-form diary-date-forms) |
1116 (and (= t1 t2) | 1117 (and (= t1 t2) |
1117 (string-lessp ts1 ts2))))))) | 1118 (string-lessp ts1 ts2))))))) |
1118 | 1119 |
1119 (defcustom diary-unknown-time | 1120 (defcustom diary-unknown-time |
1120 -9999 | 1121 -9999 |
1121 "*Value returned by diary-entry-time when no time is found. | 1122 "Value returned by diary-entry-time when no time is found. |
1122 The default value -9999 causes entries with no recognizable time to be placed | 1123 The default value -9999 causes entries with no recognizable time to be placed |
1123 before those with times; 9999 would place entries with no recognizable time | 1124 before those with times; 9999 would place entries with no recognizable time |
1124 after those with times." | 1125 after those with times." |
1125 :type 'integer | 1126 :type 'integer |
1126 :group 'diary | 1127 :group 'diary |
1359 (setq entry (if (consp diary-entry) | 1360 (setq entry (if (consp diary-entry) |
1360 (cdr diary-entry) | 1361 (cdr diary-entry) |
1361 diary-entry)) | 1362 diary-entry)) |
1362 (if diary-entry | 1363 (if diary-entry |
1363 (progn | 1364 (progn |
1364 (subst-char-in-region line-start (point) ?\^M ?\n t) | 1365 (remove-overlays line-start (point) 'invisible 'diary) |
1365 (if (< 0 (length entry)) | 1366 (if (< 0 (length entry)) |
1366 (setq temp (diary-pull-attrs entry file-glob-attrs) | 1367 (setq temp (diary-pull-attrs entry file-glob-attrs) |
1367 entry (nth 0 temp) | 1368 entry (nth 0 temp) |
1368 marks (nth 1 temp))))) | 1369 marks (nth 1 temp))))) |
1369 (add-to-diary-list date | 1370 (add-to-diary-list date |
1509 (calendar-last-day-of-month m2 y2))) | 1510 (calendar-last-day-of-month m2 y2))) |
1510 d2))))) | 1511 d2))))) |
1511 (cons mark entry))))) | 1512 (cons mark entry))))) |
1512 | 1513 |
1513 | 1514 |
1514 (defun diary-anniversary (month day year &optional mark) | 1515 (defun diary-anniversary (month day &optional year mark) |
1515 "Anniversary diary entry. | 1516 "Anniversary diary entry. |
1516 Entry applies if date is the anniversary of MONTH, DAY, YEAR if | 1517 Entry applies if date is the anniversary of MONTH, DAY, YEAR if |
1517 `european-calendar-style' is nil, and DAY, MONTH, YEAR if | 1518 `european-calendar-style' is nil, and DAY, MONTH, YEAR if |
1518 `european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the | 1519 `european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the |
1519 %d will be replaced by the number of years since the MONTH DAY, YEAR and the | 1520 %d will be replaced by the number of years since the MONTH DAY, YEAR and the |
1528 day)) | 1529 day)) |
1529 (m (if european-calendar-style | 1530 (m (if european-calendar-style |
1530 day | 1531 day |
1531 month)) | 1532 month)) |
1532 (y (extract-calendar-year date)) | 1533 (y (extract-calendar-year date)) |
1533 (diff (- y year))) | 1534 (diff (if year (- y year) 100))) |
1534 (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y))) | 1535 (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y))) |
1535 (setq m 3 | 1536 (setq m 3 |
1536 d 1)) | 1537 d 1)) |
1537 (if (and (> diff 0) (calendar-date-equal (list m d y) date)) | 1538 (if (and (> diff 0) (calendar-date-equal (list m d y) date)) |
1538 (cons mark (format entry diff (diary-ordinal-suffix diff)))))) | 1539 (cons mark (format entry diff (diary-ordinal-suffix diff)))))) |
1576 (if (= 0 (% days 7)) | 1577 (if (= 0 (% days 7)) |
1577 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) | 1578 (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks")) |
1578 (concat (int-to-string days) (if (= 1 days) " day" " days"))) | 1579 (concat (int-to-string days) (if (= 1 days) " day" " days"))) |
1579 " until " | 1580 " until " |
1580 diary-entry) | 1581 diary-entry) |
1581 "*Pseudo-pattern giving form of reminder messages in the fancy diary | 1582 "Pseudo-pattern giving form of reminder messages in the fancy diary |
1582 display. | 1583 display. |
1583 | 1584 |
1584 Used by the function `diary-remind', a pseudo-pattern is a list of | 1585 Used by the function `diary-remind', a pseudo-pattern is a list of |
1585 expressions that can involve the keywords `days' (a number), `date' (a list of | 1586 expressions that can involve the keywords `days' (a number), `date' (a list of |
1586 month, day, year), and `diary-entry' (a string)." | 1587 month, day, year), and `diary-entry' (a string)." |
1655 nil) | 1656 nil) |
1656 | 1657 |
1657 (defun make-diary-entry (string &optional nonmarking file) | 1658 (defun make-diary-entry (string &optional nonmarking file) |
1658 "Insert a diary entry STRING which may be NONMARKING in FILE. | 1659 "Insert a diary entry STRING which may be NONMARKING in FILE. |
1659 If omitted, NONMARKING defaults to nil and FILE defaults to | 1660 If omitted, NONMARKING defaults to nil and FILE defaults to |
1660 `diary-file'. Adds `diary-redraw-calendar' to | 1661 `diary-file'." |
1661 `write-contents-functions' for FILE, so that the calendar will be | |
1662 redrawn with the new entry marked, if necessary." | |
1663 (let ((pop-up-frames (window-dedicated-p (selected-window)))) | 1662 (let ((pop-up-frames (window-dedicated-p (selected-window)))) |
1664 (find-file-other-window (substitute-in-file-name (or file diary-file)))) | 1663 (find-file-other-window (substitute-in-file-name (or file diary-file)))) |
1665 (add-hook 'after-save-hook 'diary-redraw-calendar nil t) | 1664 (when (eq major-mode 'fundamental-mode) (diary-mode)) |
1666 (widen) | 1665 (widen) |
1667 (diary-unhide-everything) | 1666 (diary-unhide-everything) |
1668 (goto-char (point-max)) | 1667 (goto-char (point-max)) |
1669 (when (let ((case-fold-search t)) | 1668 (when (let ((case-fold-search t)) |
1670 (search-backward "Local Variables:" | 1669 (search-backward "Local Variables:" |
1864 '(1 diary-face))) | 1863 '(1 diary-face))) |
1865 diary-date-forms))) | 1864 diary-date-forms))) |
1866 | 1865 |
1867 (eval-when-compile (require 'cal-hebrew) | 1866 (eval-when-compile (require 'cal-hebrew) |
1868 (require 'cal-islam)) | 1867 (require 'cal-islam)) |
1868 | |
1869 (defconst diary-time-regexp | |
1870 ;; Formats that should be accepted: | |
1871 ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am | |
1872 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\(" | |
1873 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]" | |
1874 "\\)\\([AaPp][Mm]\\)?\\)")) | |
1869 | 1875 |
1870 (defvar diary-font-lock-keywords | 1876 (defvar diary-font-lock-keywords |
1871 (append | 1877 (append |
1872 (diary-font-lock-date-forms calendar-month-name-array | 1878 (diary-font-lock-date-forms calendar-month-name-array |
1873 nil calendar-month-abbrev-array) | 1879 nil calendar-month-abbrev-array) |
1905 (cons | 1911 (cons |
1906 (concat "^" (regexp-quote diary-nonmarking-symbol) | 1912 (concat "^" (regexp-quote diary-nonmarking-symbol) |
1907 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") | 1913 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") |
1908 '(1 font-lock-reference-face)) | 1914 '(1 font-lock-reference-face)) |
1909 '(diary-font-lock-sexps . font-lock-keyword-face) | 1915 '(diary-font-lock-sexps . font-lock-keyword-face) |
1910 '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?" | 1916 (cons |
1911 . font-lock-function-name-face))) | 1917 (concat ;; "^[ \t]+" |
1918 diary-time-regexp "\\(-" diary-time-regexp "\\)?") | |
1919 'font-lock-function-name-face))) | |
1912 "Forms to highlight in `diary-mode'.") | 1920 "Forms to highlight in `diary-mode'.") |
1913 | 1921 |
1914 | 1922 |
1915 ;; Following code from Dave Love <fx@gnu.org>. | 1923 ;; Following code from Dave Love <fx@gnu.org>. |
1916 ;; Import Outlook-format appointments from mail messages in Gnus or | 1924 ;; Import Outlook-format appointments from mail messages in Gnus or |