[comp.emacs] Improved Calendar Window

reingold@uiucdcsp.UUCP (12/03/87)

Here is an improved version of the calendar function I posted some weeks
ago. The improvement, by Constantine Rasmussen, is the added ability to
take a prefix argument as the offset (in months) from the current date;
this allows one to see future or past three month intervals.

Try -2823 as a prefix argument.

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

;; Calendar window function; copyright (C) 1987, Edward M. Reingold.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  The author accepts no responsibility to
;; anyone for the consequences of using it or for whether it serves
;; any particular purpose or works at all.
;; Everyone is granted permission to copy, modify, and redistribute
;; this function.
;; This notice must be preserved on all copies.
;;
;; Comments, corrections, and improvements should be sent to
;;         Edward M. Reingold
;;         Department of Computer Science
;;         University of Illinois at Urbana-Champaign
;;         1304 West Springfield Avenue
;;         Urbana, Illinois 61801
;;
;;         reingold@a.cs.uiuc.edu
;;
;; Modified 11/20/87 for month offset arguments
;;  Constantine Rasmussen            Sun Microsystems, East Coast Division
;;  (617) 671-0404                   2 Federal Street;  Billerica, Ma.  01824
;;  ARPA: cdr@sun.com   USENET: {cbosgd,decvax,hplabs,seismo}!sun!suneast!cdr
;;
;;
;; This function requires the Unix programs date and cal.

(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 (&optional month-offset)
  "Display a calendar of the current month, surrounded by calendars of the
   previous and next months.  The cursor is left indicating the date.
   A prefix argument, if any, will be treated as an offset to the present
   month to find the month to display.  In this case the day will be the
   first of the month."
  (interactive "P")
  (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
	((day (or (and month-offset " 1") 
		  (buffer-substring (match-beginning 2) (match-end 2))))
	 (month
	  (int-to-string
	   (cdr (assoc (buffer-substring (match-beginning 1) (match-end 1))
		       month-alist))))
	 (year (buffer-substring (match-beginning 3) (match-end 3))))
      (cond (month-offset
	     (setq month-offset (+ (+ (* (string-to-int year) 12)
				      (- (string-to-int month) 1))
				   month-offset))
	     (setq month (int-to-string (+ (% month-offset 12) 1)))
	     (setq year (int-to-string (/ month-offset 12)))))
      (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)
      (make-local-variable 'today)
      (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))
      (switch-to-buffer-other-window "*Calendar*")
      (let ((h (1- (window-height)))
            (l (count-lines (point-min) (point-max))))
        (or (one-window-p t)
            (<= h l)
            (shrink-window (- h l)))))))

wilkes@mips.UUCP (12/04/87)

In article <77000004@uiucdcsp> reingold@uiucdcsp.cs.uiuc.edu writes:
>
[...]
>
>;; Calendar window function; copyright (C) 1987, Edward M. Reingold.
[...]
>        (or (one-window-p t)
              ^^^^^^^^^^^^
              what is this?

On my emacs.18.35 I get:

"Symbol's function definition is void: one-window-p"

What am I missing?

Thanks.

John Wilkes
-- 
- @work: {ames,decwrl,prls,pyramid}!mips!wilkes   OR   wilkes@mips.com
- @home: {ames!ucscc.ucsc.edu,mips,elxsi}!maow!john OR maow!john@ucscc.ucsc.edu
--
The next best thing to a winning day at the track is a losing day at the track.

ram-ashwin@YALE.ARPA (Ashwin Ram) (12/05/87)

>    >        (or (one-window-p t)
>                  ^^^^^^^^^^^^
>                  what is this?
> 
>    On my emacs.18.35 I get:
> 
>    "Symbol's function definition is void: one-window-p"
> 
>    What am I missing?

Newer versions of GNU Emacs have the following defined in subr.el:

(defun one-window-p (&optional arg)
  "Returns non-nil if there is only one window.
Optional arg NOMINI non-nil means don't count the minibuffer
even if it is active."
  (eq (selected-window)
      (next-window (selected-window) (if arg 'arg))))

-- Ashwin Ram --

ARPA:    Ram-Ashwin@cs.yale.edu
UUCP:    {decvax,linus,seismo}!yale!Ram-Ashwin
BITNET:  Ram@yalecs

reingold@uiucdcsp.cs.uiuc.edu (12/06/87)

There will probably be fifty independent answers to this (parallelism!),
but since the original posting is mine, I'll answer the question:

The function one-window-p yields true if and only if there is a single
window visible on the screen. The official description is

        one-window-p:
        Returns non-nil if there is only one window.
        Optional arg NOMINI non-nil means don't count the minibuffer
        even if it is active.

This function is included in 18.49.1, at least. I don't know how far
back it goes.

For purposes of the calendar window, one can include

 (defun one-window-p () (eq (selected-window) (next-window (selected-window))))

which ALWAYS ignores the minibuffer. There are, no doubt, better ways to do it.