0793b5ebcf80cccc17f81954629703955e18175b

1 ;;; cal.el --- simple calendar functions

3 ;; This is free and unencumbered software released into the public domain.

5 ;; Author: Christopher Wellons <mosquitopsu@gmail.com>

6 ;; Version: 0.1

8 ;;; Commentary:

10 ;; `cal/insert' inserts a calendar that looks like so:

12 ;; August 2012

13 ;; S M T W T F S

14 ;; 1 2 3 4

15 ;; 5 6 7 8 9 10 11

16 ;; 12 13 14 15 16 17 18

17 ;; 19 20 21 22 23 24 25

18 ;; 26 27 28 29 30 31

20 ;;; Code:

22 (defvar cal/month-days '(31 28 31 30 31 30 31 31 30 31 30 31))

24 (defvar cal/month-names

25 '(" January" "February" " March" " April" " May" " June"

26 " July" " August" "September" " October" "November" "December"))

28 (defun cal/day-of-week (year month day)

29 "Return day of week number (0-7)."

30 (let* ((Y (if (< month 3) (1- year) year))

31 (m (1+ (mod (+ month 9) 12)))

32 (y (mod Y 100))

33 (c (/ Y 100)))

34 (mod (+ day (floor (- (* 26 m) 2) 10) y (/ y 4) (/ c 4) (* -2 c)) 7)))

36 (defun cal/leap-day (year month)

37 "Return the number of leap days to add to MONTH (0 or 1)."

38 (if (and (= month 2)

39 (or (= 0 (mod year 400))

40 (and (> (mod year 100) 0) (= 0 (mod year 4))))) 1 0))

42 ;;;###autoload

43 (defun cal/insert (year month)

44 "Insert a calendar for the given YEAR and MONTH."

45 (interactive "nYear (yyyy): \nnMonth (mm): \n")

46 (let ((dow (cal/day-of-week year month 1)))

47 (insert (format " %s %d\n" (nth (1- month) cal/month-names) year))

48 (insert " S M T W T F S\n")

49 (dotimes (i dow) (insert " "))

50 (dotimes (d (+ (nth (1- month) cal/month-days) (cal/leap-day year month)))

51 (insert (format "% 3d" (1+ d)))

52 (if (= 0 (mod (+ dow d 1) 7)) (insert "\n")))

53 (insert "\n")))

55 ;;; cal.el ends here