Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!seismo!sundc!pitstop!sun!decwrl!labrea!rutgers!bellcore!faline!ulysses!mhuxt!ihnp4!inuxc!iuvax!pur-ee!uiucdcs!uiucdcsp!reingold
From: reingold@uiucdcsp.cs.uiuc.edu
Newsgroups: comp.emacs
Subject: Calendar Window
Message-ID: <77000002@uiucdcsp>
Date: Sun, 1-Nov-87 20:29:00 EST
Article-I.D.: uiucdcsp.77000002
Posted: Sun Nov  1 20:29:00 1987
Date-Received: Fri, 6-Nov-87 23:32:07 EST
Lines: 110
Nf-ID: #N:uiucdcsp:77000002:000:4580
Nf-From: uiucdcsp.cs.uiuc.edu!reingold    Nov  1 19:29:00 1987


I recently saw a terminal that had a built-in calendar feature; on command
it would display a calendar showing the current, previous, and next months--
the cursor would show the current date. For example,

                                                                        
   October 1987            November 1987           December 1987        
 S  M Tu  W Th  F  S     S  M Tu  W Th  F  S     S  M Tu  W Th  F  S    
             1  2  3     1  2  3  4  5  6  7           1  2  3  4  5    
 4  5  6  7  8  9 10     8  9 10 11 12 13 14     6  7  8  9 10 11 12    
11 12 13 14 15 16 17    15 16 17 18 19 20 21    13 14 15 16 17 18 19    
18 19 20 21 22 23 24    22 23 24 25 26 27 28    20 21 22 23 24 25 26    
25 26 27 28 29 30 31    29 30                   27 28 29 30 31          
                                                                        

This seemed like a useful thing to have in Emacs, so I cobbled together
the following code to simulate it.

Since I am a neophyte Emacs-Lisp hacker, suggestions would be appreciated
about how to improve the code!

--------------------------cut here----------------------------------------

(defconst month-alist
      '(("Jan" . 1) ("Feb" . 2)  ("Mar" . 3)  ("Apr" . 4)
        ("May" . 5) ("Jun" . 6)  ("Jul" . 7)  ("Aug" . 8)
        ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))
      "association list of months/sequence numbers")

(defun calendar ()
  "display a calendar of the current month"
  (interactive)
  (progn
    (set-buffer (get-buffer-create "*Calendar*"))
    (message "Getting calendar...")
    (setq buffer-read-only nil)
    (erase-buffer)
    (call-process-region (point-min) (point-max) "date" t t)
    (goto-char (point-min))
    (re-search-forward
      " \\([A-Z][a-z][a-z]\\) *\\([0-9]*\\) .* \\([0-9]*\\)$" nil t)
    (let ((month
            (int-to-string
              (cdr (assoc (buffer-substring (match-beginning 1) (match-end 1))
                          month-alist))))
          (day (buffer-substring (match-beginning 2) (match-end 2)))
          (year (buffer-substring (match-beginning 3) (match-end 3))))
      (erase-buffer)
      (call-process-region (point-min) (point-max) "cal" nil t nil month year)
      (goto-char (point-min))
      (next-line 2)
      (search-forward day)
      (backward-char 1)
      (setq today (dot-marker))
      (let ((last-month
              (int-to-string
                (if (string-equal month "1")
                    12
                    (1- (string-to-int month)))))
            (last-month-year
              (if (string-equal month "1")
                  (int-to-string (1- (string-to-int year)))
                  year)))
        (goto-char (point-min))
        (insert "                        ")
        (setq top-right (dot-marker))
        (insert "\n")
        (call-process-region (point-min) (point-min)
                             "cal" nil t nil last-month last-month-year)
        (previous-line 1)
        (setq bottom-left (dot-marker))
        (kill-rectangle (marker-position top-right)
                        (marker-position bottom-left))
        (delete-region (marker-position top-right)
                       (marker-position bottom-left))
        (yank-rectangle))
      (let ((next-month
              (int-to-string
                (if (string-equal month "12")
                    1
                    (1+ (string-to-int month)))))
            (next-month-year
              (if (string-equal month "12")
                  (int-to-string (1+ (string-to-int year)))
                  year)))
        (goto-char (point-min))
        (insert "                        ")
        (setq top-right (dot-marker))
        (insert "\n")
        (call-process-region (point-min) (point-min)
                             "cal" nil t nil next-month next-month-year)
        (previous-line 1)
        (setq bottom-left (dot-marker))
        (kill-rectangle (marker-position top-right)
                        (marker-position bottom-left))
        (delete-region (marker-position top-right)
                        (marker-position bottom-left))
        (goto-char (point-min))
        (next-line 1)
        (insert "                        ")
        (end-of-line)
        (yank-rectangle))
      (goto-char (point-min))
      (next-line 1)
      (delete-region (point) (point-min))
      (setq buffer-read-only t)
      (goto-char (marker-position today))
      (if (= (current-column) 0);; yank-rect spoiled cursor location
          (forward-char 24))
      (switch-to-buffer-other-window "*Calendar*"))))