;;; liu-calendar.el --- academic calendar for Long Island University

;; Copyright 2003 Christopher League <league@contrapunctus.net>

;; This is free software -- you may redistribute it under the GNU
;; General Public License, but it comes with ABSOLUTELY NO WARRANTY.

;;; Usage:

;; This software encodes the academic calendar of my Long Island
;; University's Brooklyn Campus.  It allows me to put entries like
;; these in my Emacs diary:

;;    %%(liu-class 'fall 2003 '(1 3)) 12:00 CS101
;;    %%(liu-class 'spring 2004 '(2 4)) 15:00 CS256

;; These entries force CS101 to show up on every Monday and Wednesday
;; (days 1 and 3) of the semester in Fall 2003, and CS256 on Tuesdays
;; and Thursdays in Spring 2004.  The entries automatically know the
;; beginning and end of the semester, the academic holidays, reading
;; periods, and even the "Tuesday with a Monday schedule" that we have
;; every Spring.

;; Another nice feature -- which made the coding somewhat more
;; complex -- is that it appends the ordinal lecture number to the
;; diary entry, so that I always know how far along we are in the
;; semester. 

;;    Wednesday, November 5, 2003
;;    ===========================
;;    12:00 CS101 #18/28

;; Also the entry %%(liu-schedule) can be used to mark the beginnings
;; and ends of semesters for any year, even if you don't know yet
;; which classes to mark.

;; Probably the academic calendar at your institution is different.
;; But unless your administration changes its calendar from year to
;; year, you should be able to adapt the ideas here with minor
;; reprogramming.

;;; Code:

(require 'cl)
(provide 'liu-calendar)

(defvar liu-key-dates-cache nil
  "To speed things up, this variable caches the key dates of each
year's academic calendar.  Do not mess with it.")

(defvar liu-weeks-per-semester 14
  "This is just used to compute the number of lectures expected in any
given semester.")

(defun liu-assoc (key alist)
  "Composes `cdr' with `assoc'."
  (cdr (assoc key alist)))

(defun liu-key-dates (year)
  "Return an alist containing key dates of the academic calendar of
given year.  Uses the `liu-key-dates-cache'."
  (let ((result (assoc year liu-key-dates-cache)))
    (if result (cdr result)             ; cache hit!
      (let* ( ;; Spring semester
             (mlk-d (calendar-nth-named-absday 3 1 1 year)) ; 3rd Mon Jan
             (s-class-b (+ 1 mlk-d))    ; +1 day
             (prez-d (calendar-nth-named-absday 3 1 2 year)) ; 3rd Mon Feb
             (s-break-b (+ 28 prez-d))  ; +4 weeks
             (s-break-e (+ 7 s-break-b)) ; Mon +1 week
             (s-class-e (+ 43 s-break-e)) ; Tue +6 week
             (s-study-d (+ 1 s-class-e)) ; Wed
             (s-exams-e (+ 7 s-study-d)) ; Wed +1 week
             (grad-d (+ 1 s-exams-e)) ; Thu
             ;; Fall semester
             (labor (calendar-nth-named-absday 1 1 9 year)) ; 1st Mon Sep
             (f-class-b (+ 3 labor))    ; Thu next
             (thanks-d (calendar-nth-named-absday 4 4 11 year)) ; 4th Thu Nov
             (f-class-e (+ 15 thanks-d)) ; Fri +2 week
             (f-exams-e (+ 7 f-class-e)) ; +1 week (?)
             ;; Join them
             (alist (list (cons 's-class-b s-class-b)
                          (cons 'prez-d prez-d)
                          (cons 's-break-b s-break-b)
                          (cons 's-break-e s-break-e)
                          (cons 's-class-e s-class-e)
                          (cons 's-study-d s-study-d)
                          (cons 's-exams-e s-exams-e)
                          (cons 'grad-d grad-d)
                          (cons 'f-class-b f-class-b)
                          (cons 'thanks-d thanks-d)
                          (cons 'f-class-e f-class-e)
                          (cons 'f-exams-e f-exams-e))))
        (setq liu-key-dates-cache 
              (cons (cons year alist) liu-key-dates-cache))
        alist))))

(defun liu-class-day-p (semester year weekdays)
  "Is the current day a lecture day?"
  (let* ((alist (liu-key-dates year))
         (absday (calendar-absolute-from-gregorian date))
         (dayname (calendar-day-of-week date)))
    (cond 
     ((eq semester 'fall)
      (and (>= absday (liu-assoc 'f-class-b alist)) ; Fall semester
           (<= absday (liu-assoc 'f-class-e alist))
           (/= absday (liu-assoc 'thanks-d alist)) ; Thanksgiving break
           (/= absday (1+ (liu-assoc 'thanks-d alist)))
           (memq dayname weekdays)))
     ((eq semester 'spring)
      (and (>= absday (liu-assoc 's-class-b alist)) ; Spring semester
           (<= absday (liu-assoc 's-class-e alist))
           (not (and (>= absday (liu-assoc 's-break-b alist)) ; Spring break
                     (< absday (liu-assoc 's-break-e alist))))
           (/= absday (liu-assoc 'prez-d alist)) ; President's day
           ;; Day after president's day follows Monday schedule.
           (if (= absday (1+ (liu-assoc 'prez-d alist)))
               (memq 1 weekdays)
             (memq dayname weekdays)))))))

(defun liu-class (semester year weekdays)
  "This is used in the diary file to mark classes.  It appends to the
entry the lecture number (#6/14, for example)."
  (if (liu-class-day-p semester year weekdays)
      (let* ((alist (liu-key-dates year))
             (day (liu-assoc (if (eq semester 'fall) 'f-class-b 's-class-b) 
                             alist))
             (today (calendar-absolute-from-gregorian date))
             (total (* liu-weeks-per-semester (length weekdays)))
             (num 0))
        (while (<= day today)
          (let ((date (calendar-gregorian-from-absolute day)))
            (if (liu-class-day-p semester year weekdays)
                (setq num (1+ num))))
          (setq day (1+ day)))
        (setq entry (concat entry " #" (int-to-string num)
                            "/" (int-to-string total)))
        t)))

(defun liu-schedule ()
  "Used in the diary file to mark the beginnings and ends of
semesters, for any year."
  (let* ((year (caddr date))
         (absday (calendar-absolute-from-gregorian date))
         (alist (liu-key-dates year)))
    (cond 
     ((or (= absday (liu-assoc 'f-class-b alist))
          (= absday (liu-assoc 's-class-b alist)))
      (setq entry "First day of classes"))
     ((or (= absday (liu-assoc 'f-class-e alist))
          (= absday (liu-assoc 's-class-e alist)))
      (setq entry "Last day of classes"))
     ((or (= absday (liu-assoc 'f-exams-e alist))
          (= absday (liu-assoc 's-exams-e alist)))
      (setq entry "Last day of exams")))))


;; The rest automatically modifies the `calendar-holidays' variable so
;; that academic holidays (such as the day after Thanksgiving and
;; Spring break) are treated the same as other holidays.

(defun liu-holidays-iter (alist offset)
  (if (= 5 offset) nil
    (cons (list (calendar-gregorian-from-absolute 
                 (+ (liu-assoc 's-break-b alist) offset))
                "Spring break")
          (liu-holidays-iter alist (1+ offset)))))

(add-to-list 'calendar-holidays
             '(let* ((alist (liu-key-dates displayed-year))
                     (holidays (if (memq displayed-month '(2 3 4))
                                   (liu-holidays-iter alist 0))))
                (if (memq displayed-month '(10 11 12))
                    (add-to-list 'holidays 
                                 (list (calendar-gregorian-from-absolute
                                        (1+ (liu-assoc 'thanks-d alist)))
                                       "Thanksgiving break")))
                (if (memq displayed-month '(4 5 6))
                    (add-to-list 'holidays
                                 (list (calendar-gregorian-from-absolute
                                        (liu-assoc 's-study-d alist))
                                       "Study day")))
                holidays))

;; EOF