Function: diary-fancy-display

diary-fancy-display is a byte-compiled function defined in diary-lib.el.gz.

Signature

(diary-fancy-display)

Documentation

Prepare a diary buffer with relevant entries in a fancy, noneditable form.

Holidays are shown unless diary-show-holidays-flag is nil. Days with no diary entries are not shown (even if that day is a holiday), unless diary-list-include-blanks is non-nil.

This is an option for diary-display-function.

View in manual

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/diary-lib.el.gz
(defun diary-fancy-display ()
  "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
Holidays are shown unless `diary-show-holidays-flag' is nil.
Days with no diary entries are not shown (even if that day is a
holiday), unless `diary-list-include-blanks' is non-nil.

This is an option for `diary-display-function'."
  ;; Turn off selective-display in the diary file's buffer.
  (with-current-buffer (find-buffer-visiting diary-file)
    (diary-unhide-everything))
  (unless (car (diary-display-no-entries)) ; no entries
    ;; Prepare the fancy diary buffer.
    (calendar-in-read-only-buffer diary-fancy-buffer
      (calendar-set-mode-line "Diary Entries")
      (let ((holiday-list-last-month 1)
            (holiday-list-last-year 1)
            (date (list 0 0 0))
            holiday-list)
        (dolist (entry diary-entries-list)
          (unless (calendar-date-equal date (car entry))
            (setq date (car entry))
            (and diary-show-holidays-flag
                 (calendar-date-compare
                  (list (list holiday-list-last-month
                              (calendar-last-day-of-month
                               holiday-list-last-month
                               holiday-list-last-year)
                              holiday-list-last-year))
                  (list date))
                 ;; We need to get the holidays for the next 3 months.
                 (setq holiday-list-last-month
                       (calendar-extract-month date)
                       holiday-list-last-year
                       (calendar-extract-year date))
                 (progn
                   (calendar-increment-month
                    holiday-list-last-month holiday-list-last-year 1)
                   t)
                 (setq holiday-list
                       (let ((displayed-month holiday-list-last-month)
                             (displayed-year holiday-list-last-year))
                         (calendar-holiday-list)))
                 (calendar-increment-month
                  holiday-list-last-month holiday-list-last-year 1))
            (let ((longest 0)
                  date-holiday-list cc)
              ;; Make a list of all holidays for date.
              (dolist (h holiday-list)
                (if (calendar-date-equal date (car h))
                    (setq date-holiday-list (append date-holiday-list
                                                    (cdr h)))))
              (insert (if (bobp) "" ?\n)
                      (propertize (calendar-date-string date)
                                  'font-lock-face 'diary))
              (if date-holiday-list (insert ":  "))
              (setq cc (current-column))
              (insert (mapconcat (lambda (x)
                                   (setq longest (max longest (length x)))
                                   x)
                                 date-holiday-list
                                 (concat "\n" (make-string cc ?\s))))
              (insert ?\n
                      (propertize (make-string (+ cc longest) ?=)
                                  'font-lock-face 'diary)
                      ?\n)))
          (let ((this-entry (cadr entry))
                this-loc marks temp-face)
            (unless (zerop (length this-entry))
              (if (setq this-loc (nth 3 entry))
                  (insert-button this-entry
                                 ;; (MARKER FILENAME SPECIFIER LITERAL)
                                 'locator (list (car this-loc)
                                                (cadr this-loc)
                                                (nth 2 entry)
                                                (or (nth 2 this-loc)
                                                    (nth 1 entry)))
                                 :type 'diary-entry)
                (insert this-entry))
              (insert ?\n)
              ;; Doesn't make sense to check font-lock-mode - see
              ;; comments above diary-entry-marker in calendar.el.
              (and ; font-lock-mode
                   (setq marks (nth 4 entry))
                   (save-excursion
                     (setq temp-face (calendar-make-temp-face marks))
                     (search-backward this-entry)
                     (overlay-put
                      (make-overlay (match-beginning 0) (match-end 0))
                      'face temp-face)))))))
      ;; FIXME can't remember what this check was for.
      ;; To prevent something looping, or a minor optimization?
      (if (eq major-mode 'diary-fancy-display-mode)
          (run-hooks 'diary-fancy-display-mode-hook)
        (diary-fancy-display-mode))
      (calendar-set-mode-line diary--date-string))))