/[emacs]/emacs/lisp/calendar/diary-lib.el
ViewVC logotype

Diff of /emacs/lisp/calendar/diary-lib.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.69.2.2 by miles, Mon Jun 28 07:29:41 2004 UTC revision 1.69.2.3 by miles, Wed Sep 29 07:22:20 2004 UTC
# Line 4  Line 4 
4  ;;           Free Software Foundation, Inc.  ;;           Free Software Foundation, Inc.
5    
6  ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>  ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7    ;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
8  ;; Keywords: calendar  ;; Keywords: calendar
9    
10  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 296  Only used if `diary-header-line-flag' is Line 297  Only used if `diary-header-line-flag' is
297    :type    'sexp    :type    'sexp
298    :version "21.4")    :version "21.4")
299    
300    (defvar diary-saved-point)              ; internal
301    
302  (defun list-diary-entries (date number)  (defun list-diary-entries (date number)
303    "Create and display a buffer containing the relevant lines in diary-file.    "Create and display a buffer containing the relevant lines in diary-file.
304  The arguments are DATE and NUMBER; the entries selected are those  The arguments are DATE and NUMBER; the entries selected are those
# Line 345  These hooks have the following distinct Line 348  These hooks have the following distinct
348              (set-buffer diary-buffer)              (set-buffer diary-buffer)
349              (or (verify-visited-file-modtime diary-buffer)              (or (verify-visited-file-modtime diary-buffer)
350                  (revert-buffer t t))))                  (revert-buffer t t))))
351          (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))          ;; d-s-p is passed to the diary display function.
352          (setq selective-display t)          (let ((diary-saved-point (point)))
353          (setq selective-display-ellipses nil)            (save-excursion
354          (if diary-header-line-flag              (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
355              (setq header-line-format diary-header-line-format))              (setq selective-display t)
356          (setq old-diary-syntax-table (syntax-table))              (setq selective-display-ellipses nil)
357          (set-syntax-table diary-syntax-table)              (if diary-header-line-flag
358          (unwind-protect                  (setq header-line-format diary-header-line-format))
359              (let ((buffer-read-only nil)              (setq old-diary-syntax-table (syntax-table))
360                    (diary-modified (buffer-modified-p))              (set-syntax-table diary-syntax-table)
361                    (mark (regexp-quote diary-nonmarking-symbol)))              (unwind-protect
362                ;; First and last characters must be ^M or \n for                  (let ((buffer-read-only nil)
363                ;; selective display to work properly                        (diary-modified (buffer-modified-p))
364                (goto-char (1- (point-max)))                        (mark (regexp-quote diary-nonmarking-symbol)))
365                (if (not (looking-at "\^M\\|\n"))                    ;; First and last characters must be ^M or \n for
366                    (progn                    ;; selective display to work properly
367                      (goto-char (point-max))                    (goto-char (1- (point-max)))
368                      (insert "\^M")))                    (if (not (looking-at "\^M\\|\n"))
369                (goto-char (point-min))                        (progn
370                (if (not (looking-at "\^M\\|\n"))                          (goto-char (point-max))
371                    (insert "\^M"))                          (insert "\^M")))
372                (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)                    (goto-char (point-min))
373                (calendar-for-loop i from 1 to number do                    (if (not (looking-at "\^M\\|\n"))
374                   (let ((d diary-date-forms)                        (insert "\^M"))
375                         (month (extract-calendar-month date))                    (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
376                         (day (extract-calendar-day date))                    (calendar-for-loop
377                         (year (extract-calendar-year date))                     i from 1 to number do
378                         (entry-found (list-sexp-diary-entries date)))                     (let ((d diary-date-forms)
379                     (while d                           (month (extract-calendar-month date))
380                       (let*                           (day (extract-calendar-day date))
381                            ((date-form (if (equal (car (car d)) 'backup)                           (year (extract-calendar-year date))
382                                            (cdr (car d))                           (entry-found (list-sexp-diary-entries date)))
383                                          (car d)))                       (while d
384                            (backup (equal (car (car d)) 'backup))                         (let*
385                            (dayname                             ((date-form (if (equal (car (car d)) 'backup)
386                             (format "%s\\|%s\\.?"                                             (cdr (car d))
387                              (calendar-day-name date)                                           (car d)))
388                              (calendar-day-name date 'abbrev)))                              (backup (equal (car (car d)) 'backup))
389                            (monthname                              (dayname
390                             (format "\\*\\|%s\\|%s\\.?"                               (format "%s\\|%s\\.?"
391                              (calendar-month-name month)                                       (calendar-day-name date)
392                              (calendar-month-name month 'abbrev)))                                       (calendar-day-name date 'abbrev)))
393                            (month (concat "\\*\\|0*" (int-to-string month)))                              (monthname
394                            (day (concat "\\*\\|0*" (int-to-string day)))                               (format "\\*\\|%s\\|%s\\.?"
395                            (year                                       (calendar-month-name month)
396                             (concat                                       (calendar-month-name month 'abbrev)))
397                              "\\*\\|0*" (int-to-string year)                              (month (concat "\\*\\|0*" (int-to-string month)))
398                              (if abbreviated-calendar-year                              (day (concat "\\*\\|0*" (int-to-string day)))
399                                  (concat "\\|" (format "%02d" (% year 100)))                              (year
400                                "")))                               (concat
401                            (regexp                                "\\*\\|0*" (int-to-string year)
402                             (concat                                (if abbreviated-calendar-year
403                              "\\(\\`\\|\^M\\|\n\\)" mark "?\\("                                    (concat "\\|" (format "%02d" (% year 100)))
404                              (mapconcat 'eval date-form "\\)\\(")                                  "")))
405                              "\\)"))                              (regexp
406                            (case-fold-search t))                               (concat
407                         (goto-char (point-min))                                "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
408                         (while (re-search-forward regexp nil t)                                (mapconcat 'eval date-form "\\)\\(")
409                           (if backup (re-search-backward "\\<" nil t))                                "\\)"))
410                           (if (and (or (char-equal (preceding-char) ?\^M)                              (case-fold-search t))
411                                        (char-equal (preceding-char) ?\n))                           (goto-char (point-min))
412                                    (not (looking-at " \\|\^I")))                           (while (re-search-forward regexp nil t)
413                               ;;  Diary entry that consists only of date.                             (if backup (re-search-backward "\\<" nil t))
414                               (backward-char 1)                             (if (and (or (char-equal (preceding-char) ?\^M)
415                             ;; Found a nonempty diary entry--make it visible and                                          (char-equal (preceding-char) ?\n))
416                             ;; add it to the list.                                      (not (looking-at " \\|\^I")))
417                             (setq entry-found t)                                 ;;  Diary entry that consists only of date.
418                             (let ((entry-start (point))                                 (backward-char 1)
419                                   date-start temp)                               ;; Found a nonempty diary entry--make it
420                               (re-search-backward "\^M\\|\n\\|\\`")                               ;; visible and add it to the list.
421                               (setq date-start (point))                               (setq entry-found t)
422                               (re-search-forward "\^M\\|\n" nil t 2)                               (let ((entry-start (point))
423                               (while (looking-at " \\|\^I")                                     date-start temp)
424                                 (re-search-forward "\^M\\|\n" nil t))                                 (re-search-backward "\^M\\|\n\\|\\`")
425                               (backward-char 1)                                 (setq date-start (point))
426                               (subst-char-in-region date-start                                 (re-search-forward "\^M\\|\n" nil t 2)
427                                  (point) ?\^M ?\n t)                                 (while (looking-at " \\|\^I")
428                               (setq entry (buffer-substring entry-start (point))                                   (re-search-forward "\^M\\|\n" nil t))
429                                     temp (diary-pull-attrs entry file-glob-attrs)                                 (backward-char 1)
430                                     entry (nth 0 temp))                                 (subst-char-in-region date-start
431                               (add-to-diary-list                                                       (point) ?\^M ?\n t)
432                                date                                 (setq entry (buffer-substring entry-start (point))
433                                entry                                       temp (diary-pull-attrs entry file-glob-attrs)
434                                (buffer-substring                                       entry (nth 0 temp))
435                                 (1+ date-start) (1- entry-start))                                 (add-to-diary-list
436                                (copy-marker entry-start) (nth 1 temp))))))                                  date
437                       (setq d (cdr d)))                                  entry
438                     (or entry-found                                  (buffer-substring
439                         (not diary-list-include-blanks)                                   (1+ date-start) (1- entry-start))
440                         (setq diary-entries-list                                  (copy-marker entry-start) (nth 1 temp))))))
441                               (append diary-entries-list                         (setq d (cdr d)))
442                                       (list (list date "" "" "" "")))))                       (or entry-found
443                     (setq date                           (not diary-list-include-blanks)
444                           (calendar-gregorian-from-absolute                           (setq diary-entries-list
445                             (1+ (calendar-absolute-from-gregorian date))))                                 (append diary-entries-list
446                     (setq entry-found nil)))                                         (list (list date "" "" "" "")))))
447                (set-buffer-modified-p diary-modified))                       (setq date
448            (set-syntax-table old-diary-syntax-table))                             (calendar-gregorian-from-absolute
449          (goto-char (point-min))                              (1+ (calendar-absolute-from-gregorian date))))
450          (run-hooks 'nongregorian-diary-listing-hook                       (setq entry-found nil)))
451                     'list-diary-entries-hook)                    (set-buffer-modified-p diary-modified))
452          (if diary-display-hook                (set-syntax-table old-diary-syntax-table))
453              (run-hooks 'diary-display-hook)              (goto-char (point-min))
454            (simple-diary-display))              (run-hooks 'nongregorian-diary-listing-hook
455          (run-hooks 'diary-hook)                         'list-diary-entries-hook)
456          diary-entries-list))))              (if diary-display-hook
457                    (run-hooks 'diary-display-hook)
458                  (simple-diary-display))
459                (run-hooks 'diary-hook)
460                diary-entries-list))))))
461    
462  (defun include-other-diary-files ()  (defun include-other-diary-files ()
463    "Include the diary entries from other diary files with those of diary-file.    "Include the diary entries from other diary files with those of diary-file.
# Line 528  changing the variable `diary-include-str Line 535  changing the variable `diary-include-str
535            (setq buffer-read-only t)            (setq buffer-read-only t)
536            (display-buffer holiday-buffer)            (display-buffer holiday-buffer)
537            (message  "No diary entries for %s" date-string))            (message  "No diary entries for %s" date-string))
538        (display-buffer (find-buffer-visiting        (with-current-buffer
539                         (substitute-in-file-name diary-file)))            (find-buffer-visiting (substitute-in-file-name diary-file))
540            (let ((window (display-buffer (current-buffer))))
541              ;; d-s-p is passed from list-diary-entries.
542              (set-window-point window diary-saved-point)
543              (set-window-start window (point-min))))
544        (message "Preparing diary...done"))))        (message "Preparing diary...done"))))
545    
546  (defface diary-button-face '((((type pc) (class color))  (defface diary-button-face '((((type pc) (class color))

Legend:
Removed from v.1.69.2.2  
changed lines
  Added in v.1.69.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26