Function: diary-mark-sexp-entries

diary-mark-sexp-entries is a byte-compiled function defined in diary-lib.el.gz.

Signature

(diary-mark-sexp-entries)

Documentation

Mark days in the calendar window that have sexp diary entries.

Each entry in the diary file (or included files) visible in the calendar window is marked. See the documentation for the function diary-list-sexp-entries.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/diary-lib.el.gz
(defun diary-mark-sexp-entries ()
  "Mark days in the calendar window that have sexp diary entries.
Each entry in the diary file (or included files) visible in the calendar window
is marked.  See the documentation for the function `diary-list-sexp-entries'."
  (let* ((sexp-mark (regexp-quote diary-sexp-entry-symbol))
         (s-entry (format "^\\(%s(\\)\\|\\(%s%s(diary-remind\\)" sexp-mark
                          (regexp-quote diary-nonmarking-symbol)
                          sexp-mark))
         (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
         m y first-date last-date date mark file-glob-attrs
         sexp-start sexp entry entry-start)
    (with-current-buffer calendar-buffer
      (setq m displayed-month
            y displayed-year))
    (calendar-increment-month m y -1)
    (setq first-date (calendar-absolute-from-gregorian (list m 1 y)))
    (calendar-increment-month m y 2)
    (setq last-date
          (calendar-absolute-from-gregorian
           (list m (calendar-last-day-of-month m y) y)))
    (goto-char (point-min))
    (while (re-search-forward s-entry nil t)
      (setq diary-marking-entry-flag (char-equal (preceding-char) ?\())
      (re-search-backward "(")
      (setq sexp-start (point))
      (forward-sexp)
      (setq sexp (buffer-substring-no-properties sexp-start (point)))
      (forward-char 1)
      (if (and (bolp) (not (looking-at "[ \t]")))
          ;; Diary entry consists only of the sexp.
          (progn
            (backward-char 1)
            (setq entry ""))
        (setq entry-start (point))
        ;; Find end of entry.
        (forward-line 1)
        (while (looking-at "[ \t]")
          (forward-line 1))
        (if (bolp) (backward-char 1))
        (setq entry (buffer-substring-no-properties entry-start (point))))
      (setq date (1- first-date))
      ;; FIXME this loops over all visible dates.
      ;; Could be optimized in many cases. Depends on whether t or * present.
      (while (<= (setq date (1+ date)) last-date)
        (when (setq mark (diary-sexp-entry
                          sexp entry
                          (calendar-gregorian-from-absolute date)))
          (calendar-mark-visible-date
           (calendar-gregorian-from-absolute date)
           (or (cadr (diary-pull-attrs entry file-glob-attrs))
               (if (consp mark) (car mark)))))))))