Function: calendar-generate-month

calendar-generate-month is a byte-compiled function defined in calendar.el.gz.

Signature

(calendar-generate-month MONTH YEAR INDENT)

Documentation

Produce a calendar for MONTH, YEAR on the Gregorian calendar.

The calendar is inserted at the top of the buffer in which point is currently located, but indented INDENT spaces. The indentation is done from the first character on the line and does not disturb the first INDENT characters on the line.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/calendar.el.gz
(defun calendar-generate-month (month year indent)
  "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
The calendar is inserted at the top of the buffer in which point is
currently located, but indented INDENT spaces.  The indentation is
done from the first character on the line and does not disturb the
first INDENT characters on the line."
  (let ((blank-days                     ; at start of month
         (mod
          (- (calendar-day-of-week (list month 1 year))
             calendar-week-start-day)
          7))
         (last (calendar-last-day-of-month month year))
         (trunc (min calendar-intermonth-spacing
                     (1- calendar-left-margin)))
         (day 1)
         j)
   (goto-char (point-min))
   (calendar-move-to-column indent)
   (insert
    (calendar-dlet ((month month) (year year))
      (calendar-string-spread (list calendar-month-header)
                              ?\s calendar-month-digit-width)))
   (calendar-ensure-newline)
   (calendar-insert-at-column indent calendar-intermonth-header trunc)
   ;; Use the first N characters of each day to head the columns.
   (dotimes (i 7)
     (setq j (mod (+ calendar-week-start-day i) 7))
     (insert
      (truncate-string-to-width
       (propertize (calendar-day-name j 'header t)
                   'font-lock-face (if (memq j calendar-weekend-days)
                                       'calendar-weekend-header
                                     'calendar-weekday-header))
       calendar-day-header-width nil ?\s)
      (make-string (- calendar-column-width calendar-day-header-width) ?\s)))
   (calendar-ensure-newline)
   (calendar-dlet ((day day) (month month) (year year))
     (calendar-insert-at-column indent calendar-intermonth-text trunc))
   ;; Add blank days before the first of the month.
   (insert (make-string (* blank-days calendar-column-width) ?\s))
   ;; Put in the days of the month.
   (dotimes (i last)
     (setq day (1+ i))
     ;; TODO should numbers be left-justified, centered...?
     (insert (propertize
              (format (format "%%%dd" calendar-day-digit-width) day)
              'mouse-face 'highlight
              'help-echo (calendar-dlet ((day day) (month month) (year year))
                           (eval calendar-date-echo-text t))
              ;; 'date property prevents intermonth text confusing re-searches.
              ;; (Tried intangible, it did not really work.)
              'date t)
             (make-string
              (- calendar-column-width calendar-day-digit-width) ?\s))
     (when (and (zerop (mod (+ day blank-days) 7))
                (/= day last))
       (calendar-ensure-newline)
       (setq day (1+ day))              ; first day of next week
       (calendar-dlet ((day day) (month month) (year year))
         (calendar-insert-at-column indent calendar-intermonth-text trunc))))))