Mercurial > hg > xemacs-beta

comparison lisp/calendar/cal-x.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; cal-x.el --- calendar windows in dedicated frames in x-windows
2
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
4
5 ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
6 ;; Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Modified for XEmacs by: Chuck Thompson <cthomp@cs.uiuc.edu>
8 ;; Keywords: calendar
9 ;; Human-Keywords: calendar, dedicated frames, x-windows
10
11 ;; This file is part of GNU Emacs.
12
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version.
17
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26
27 ;;; Commentary:
28
29 ;; This collection of functions implements dedicated frames in x-windows for
30 ;; calendar.el.
31
32 ;; Comments, corrections, and improvements should be sent to
33 ;; Edward M. Reingold Department of Computer Science
34 ;; (217) 333-6733 University of Illinois at Urbana-Champaign
35 ;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
36 ;; Urbana, Illinois 61801
37
38 ;;; Code:
39
40 (require 'calendar)
41 (if (not (fboundp 'calendar-basic-setup))
42 (fset 'calendar-basic-setup (symbol-function 'calendar)))
43
44 ;;;###autoload
45 (defvar calendar-setup 'one-frame
46 "The frame set up of the calendar.
47 The choices are `one-frame' (calendar and diary together in one separate,
48 dediciated frame) or `two-frames' (calendar and diary in separate, dedicated
49 frames); with any other value the current frame is used.")
50
51 (defun calendar (&optional arg)
52 "Choose between the one frame, two frame, or basic calendar displays.
53 The original function `calendar' has been renamed `calendar-basic-setup'."
54 (interactive "P")
55 (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
56 ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
57 (t (calendar-basic-setup arg))))
58
59 (defvar calendar-frame nil "Frame in which to display the calendar.")
60
61 (defvar diary-frame nil "Frame in which to display the diary.")
62
63 (defvar diary-frame-parameters
64 '((name . "Diary") (height . 10) (width . 80) (unsplittable . t)
65 (font . "6x13") (auto-lower . t) (auto-raise . t) (minibuffer . nil))
66 "Parameters of the diary frame, if the diary is in its own frame.
67 Location and color should be set in .Xdefaults.")
68
69 (defvar calendar-frame-parameters
70 '((name . "Calendar") (minibuffer . nil) (height . 10) (width . 80)
71 (auto-raise . t) (auto-lower . t) (font . "6x13") (unsplittable . t)
72 (vertical-scroll-bars . nil))
73 "Parameters of the calendar frame, if the calendar is in a separate frame.
74 Location and color should be set in .Xdefaults.")
75
76 (defvar calendar-and-diary-frame-parameters
77 '((name . "Calendar") (height . 28) (width . 80) (minibuffer . nil)
78 (font . "6x13") (auto-raise . t) (auto-lower . t))
79 "Parameters of the frame that displays both the calendar and the diary.
80 Location and color should be set in .Xdefaults.")
81
82 (defvar calendar-after-frame-setup-hooks nil
83 "Hooks to be run just after setting up a calendar frame.
84 Can be used to change frame parameters, such as font, color, location, etc.")
85
86 (defun calendar-not-using-window-system-p ()
87 "Return t if not running under a window system."
88 (if (fboundp 'device-type)
89 (not (eq (device-type (selected-device)) 'x))
90 (not window-system)))
91
92 (defun calendar-deiconify-frame (frame)
93 "Deiconify the given frame if it is currently iconified."
94 (if (string-match "XEmacs" emacs-version)
95 (if (frame-iconified-p frame)
96 (deiconify-frame frame))
97 (if (eq 'icon (cdr (assoc 'visibility (frame-parameters frame))))
98 ;; This isn't necessary going to do what is intended since it
99 ;; only works with the selected frame.
100 (iconify-or-deiconify-frame))))
101
102 (defun calendar-one-frame-setup (&optional arg)
103 "Start calendar and display it in a dedicated frame together with the diary."
104 (if (calendar-not-using-window-system-p)
105 (calendar-basic-setup arg)
106 (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
107 (if (frame-live-p diary-frame) (delete-frame diary-frame))
108 (let ((special-display-buffer-names nil)
109 (view-diary-entries-initially t))
110 (save-window-excursion
111 (save-excursion
112 (setq calendar-frame
113 (make-frame calendar-and-diary-frame-parameters))
114 (run-hooks 'calendar-after-frame-setup-hooks)
115 (select-frame calendar-frame)
116 (calendar-deiconify-frame calendar-frame)
117 (calendar-basic-setup arg)
118 (set-window-dedicated-p (selected-window) 'calendar)
119 (set-window-dedicated-p
120 (display-buffer
121 (if (not (memq 'fancy-diary-display diary-display-hook))
122 (get-file-buffer diary-file)
123 (if (not (bufferp (get-buffer fancy-diary-buffer)))
124 (make-fancy-diary-buffer))
125 fancy-diary-buffer))
126 'diary))))))
127
128 (defun calendar-two-frame-setup (&optional arg)
129 "Start calendar and diary in separate, dedicated frames."
130 (if (calendar-not-using-window-system-p)
131 (calendar-basic-setup arg)
132 (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
133 (if (frame-live-p diary-frame) (delete-frame diary-frame))
134 (let ((pop-up-windows nil)
135 (view-diary-entries-initially nil)
136 (special-display-buffer-names nil))
137 (save-window-excursion
138 (save-excursion (calendar-basic-setup arg))
139 (setq calendar-frame (make-frame calendar-frame-parameters))
140 (run-hooks 'calendar-after-frame-setup-hooks)
141 (select-frame calendar-frame)
142 (calendar-deiconify-frame calendar-frame)
143 (display-buffer calendar-buffer)
144 (set-window-dedicated-p (selected-window) 'calendar)
145 (setq diary-frame (make-frame diary-frame-parameters))
146 (run-hooks 'calendar-after-frame-setup-hooks)
147 (select-frame diary-frame)
148 (calendar-deiconify-frame diary-frame)
149 (save-excursion (diary))
150 (set-window-dedicated-p
151 (display-buffer
152 (if (not (memq 'fancy-diary-display diary-display-hook))
153 (get-file-buffer diary-file)
154 (if (not (bufferp (get-buffer fancy-diary-buffer)))
155 (make-fancy-diary-buffer))
156 fancy-diary-buffer))
157 'diary)))))
158
159 (defun make-fancy-diary-buffer ()
160 (save-excursion
161 (set-buffer (get-buffer-create fancy-diary-buffer))
162 (setq buffer-read-only nil)
163 (make-local-variable 'mode-line-format)
164 (calendar-set-mode-line "Diary Entries")
165 (erase-buffer)
166 (set-buffer-modified-p nil)
167 (setq buffer-read-only t)))
168
169 (if (not (string-match "XEmacs" emacs-version))
170 (setq special-display-buffer-names
171 (append special-display-buffer-names
172 (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
173 fancy-diary-buffer (get-file-buffer diary-file)
174 calendar-buffer))))
175
176 (run-hooks 'cal-x-load-hook)
177
178 (provide 'cal-x)
179
180 ;;; cal-x.el ends here