;; - Done for 19.31.97, Affi 1996/6/26
;; - Last fix for 19.34, Affi 1996/11/2
;; - Made week name be up to tree chars (done in 21.3), Affi 2005/05/04
;; - `facemenu-unlisted-faces' not defined in Emacs 22, 
;;     Affi/Kevin Rodgers 2006/12/06

(require 'calendar)
(require 'cal-iso)
(require 'faces)
(require 'font-lock)

(defvar calendar-use-colours window-system
  "Tries to fontify Calendar if non-nil.  Default set to `window-system'.")

(defvar calendar-week-string "WK"
  "String (up to three chars) used in calendar header to identify week numbers.")

;; Prelimenary face stuff
(if (not calendar-use-colours)
    nil
  (set-face-foreground 'diary-face "black")
  (make-face-bold 'diary-face)

  (if (boundp 'facemenu-unlisted-faces)
      (add-to-list 'facemenu-unlisted-faces 'calendar-week-face))
  (make-face 'calendar-week-face)
  (cond ((face-differs-from-default-p 'calendar-week-face))
	((x-display-color-p)
	 (set-face-foreground 'calendar-week-face "blue"))
	(t (copy-face 'bold 'calendar-week-face)))

  (if (boundp 'facemenu-unlisted-faces)
      (add-to-list 'facemenu-unlisted-faces 'calendar-header-face))
  (make-face 'calendar-header-face)
  (cond ((face-differs-from-default-p 'calendar-header-face))
	((x-display-color-p)
	 (set-face-foreground 'calendar-header-face "ForestGreen"))
	(t (copy-face 'bold 'calendar-header-face)))
  (make-face-bold 'calendar-header-face)

  (if (boundp 'facemenu-unlisted-faces)
      (add-to-list 'facemenu-unlisted-faces 'calendar-sunday-face))
  (make-face 'calendar-sunday-face)
  (cond ((face-differs-from-default-p 'calendar-sunday-face))
	((x-display-color-p)
	 (set-face-foreground 'calendar-sunday-face "red"))
	(t (copy-face 'bold 'calendar-sunday-face))))

(defun generate-calendar-month (month year indent)
  "Produce a calendar for ISO-week, month, year on the Gregorian calendar.
The calendar is inserted in the buffer starting at the line on 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)))
    (goto-char (point-min))
    (calendar-insert-indented
     (calendar-string-spread
      (list (format "%s %d" (calendar-month-name month) year)) ?  20)
     indent t)
    ;; Add colour to month name
    (if calendar-use-colours
	(overlay-put (make-overlay (point-min) (1- (point)))
		     'face 'calendar-header-face))
    (calendar-insert-indented "" indent) ; Go to proper spot
    (calendar-for-loop
     i from 0 to 6 do
     (insert (substring (aref calendar-day-name-array
			      (mod (+ calendar-week-start-day i) 7)) 0 2))
     ;; Add colour to week day names and sundays
     (if calendar-use-colours
	 (overlay-put (make-overlay  (- (point) 2) (point)) 'face
		      (if (= 0 (mod (+ calendar-week-start-day i) 7))
			  'calendar-sunday-face
			'calendar-header-face)))
     (insert " "))
    ;; Add week-string after week dates
    (insert (concat calendar-week-string 
		    (make-string (- 3 (length calendar-week-string)) ? )))
    ;; Add colour to week-string
    (if calendar-use-colours
	(overlay-put (make-overlay  (- (point) 3) (point))
		     'face 'calendar-week-face))
    (calendar-insert-indented "" 0 t);; Force onto following line
    (calendar-insert-indented "" indent);; Go to proper spot
    ;; Add blank days before the first of the month
    (calendar-for-loop i from 1 to blank-days do (insert "   "))
    ;; Put in the days of the month
    (calendar-for-loop
     i from 1 to last do
     (insert (format "%2d " i))
     (if (not calendar-use-colours)
	 nil
       (put-text-property (- (point) 3) (1- (point)) 'mouse-face 'highlight)
       ;; Add colour to sunday
       (if (= 1 (mod (+ blank-days calendar-week-start-day i) 7))
	   (overlay-put (make-overlay  (- (point) 3) (1- (point)))
			'face 'calendar-sunday-face)))
     (and (zerop (mod (+ i blank-days) 7))
	  ;; Add ISO-week # at the end each week entry
	  (require 'cal-iso)
	  (not (insert
		(format "%2d " (extract-calendar-month
				(calendar-iso-from-absolute
				 (calendar-absolute-from-gregorian
				  (list month i year)))))))
	  ;; Add colour to week #
	  (if calendar-use-colours
	      (overlay-put (make-overlay  (- (point) 3) (1- (point)))
			   'face 'calendar-week-face)
	    t)
	  (/= i last)
	  (calendar-insert-indented "" 0 t);; Force onto following line
	  (calendar-insert-indented "" indent)))));; Go to proper spot

(provide 'calendar-hack)