code.delx.au - gnu-emacs/blob - lisp/calendar/cal-x.el

   1 ;;; cal-x.el --- calendar windows in dedicated frames
   2
   3 ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
   4 ;;   2008, 2009, 2010, 2011  Free Software Foundation, Inc.
   5
   6 ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
   7 ;;         Edward M. Reingold <reingold@cs.uiuc.edu>
   8 ;; Maintainer: Glenn Morris <rgm@gnu.org>
   9 ;; Keywords: calendar
  10 ;; Human-Keywords: calendar, dedicated frames
  11 ;; Package: calendar
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software: you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation, either version 3 of the License, or
  18 ;; (at your option) any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  27
  28 ;;; Commentary:
  29
  30 ;; See calendar.el.
  31
  32 ;;; Code:
  33
  34 (require 'calendar)
  35
  36 (defcustom diary-frame-parameters
  37   '((name . "Diary") (title . "Diary") (height . 10) (width . 80)
  38     (unsplittable . t) (minibuffer . nil))
  39   "Parameters of the diary frame, if the diary is in its own frame.
  40 Relevant if `calendar-setup' has the value `two-frames'."
  41   :type 'alist
  42   :options '((name string) (title string) (height integer) (width integer)
  43              (unsplittable boolean) (minibuffer boolean)
  44              (vertical-scroll-bars boolean))
  45   :group 'calendar)
  46
  47 (defcustom calendar-frame-parameters
  48   '((name . "Calendar") (title . "Calendar") (height . 10) (width . 80)
  49     (unsplittable . t) (minibuffer . nil) (vertical-scroll-bars . nil))
  50   "Parameters of the calendar frame, if the calendar is in a separate frame.
  51 Relevant if `calendar-setup' has the value `calendar-only' or `two-frames'."
  52   :type 'alist
  53   :options '((name string) (title string) (height integer) (width integer)
  54              (unsplittable boolean) (minibuffer boolean)
  55              (vertical-scroll-bars boolean))
  56   :group 'calendar)
  57
  58 (defcustom calendar-and-diary-frame-parameters
  59   '((name . "Calendar") (title . "Calendar") (height . 28) (width . 80)
  60     (minibuffer . nil))
  61   "Parameters of the frame that displays both the calendar and the diary.
  62 Relevant if `calendar-setup' has the value `one-frame'."
  63   :type 'alist
  64   :options '((name string) (title string) (height integer) (width integer)
  65              (unsplittable boolean) (minibuffer boolean)
  66              (vertical-scroll-bars boolean))
  67   :group 'calendar)
  68
  69 (define-obsolete-variable-alias 'calendar-after-frame-setup-hooks
  70   'calendar-after-frame-setup-hook "23.1")
  71
  72 (defcustom calendar-after-frame-setup-hook nil
  73   "List of functions to be run after creating a calendar and/or diary frame."
  74   :type 'hook
  75   :group 'calendar-hooks)
  76
  77 ;;; End of user options.
  78
  79 (defvar calendar-frame nil
  80   "Frame in which the calendar was last displayed.")
  81
  82 (defvar diary-frame nil
  83   "Frame in which the diary was last displayed.")
  84
  85 (defun calendar-frame-1 (frame)
  86   "Subroutine used by `calendar-frame-setup'.
  87 Runs `calendar-after-frame-setup-hook', selects frame, iconifies if needed."
  88   (run-hooks 'calendar-after-frame-setup-hook)
  89   (select-frame frame)
  90   (if (eq 'icon (cdr (assoc 'visibility (frame-parameters frame))))
  91       (iconify-or-deiconify-frame)))
  92
  93 ;; c-d-d is only called after (diary) has been run.
  94 (defvar diary-display-function)
  95
  96 (defun calendar-dedicate-diary ()
  97   "Display and dedicate the window associated with the diary buffer."
  98   (set-window-dedicated-p
  99    (display-buffer
 100     (if (if (listp diary-display-function)
 101             (or (memq 'diary-fancy-display diary-display-function)
 102                 (memq 'fancy-diary-display diary-display-function))
 103           (memq diary-display-function '(diary-fancy-display
 104                                          fancy-diary-display)))
 105         (progn
 106           ;; If there are no diary entries, there won't be a fancy-diary
 107           ;; to dedicate, so make a basic one.
 108           (or (get-buffer diary-fancy-buffer)
 109               (calendar-in-read-only-buffer diary-fancy-buffer
 110                 (calendar-set-mode-line "Diary Entries")))
 111           diary-fancy-buffer)
 112       (get-file-buffer diary-file)))
 113    t))
 114
 115 ;;;###cal-autoload
 116 (defun calendar-frame-setup (config &optional prompt)
 117   "Display the calendar, and optionally the diary, in a separate frame.
 118 CONFIG should be one of:
 119 `calendar-only' - just the calendar, no diary
 120 `one-frame'     - calendar and diary in a single frame
 121 `two-frames'    - calendar and diary each in a separate frame
 122
 123 If CONFIG has any other value, or if the display is not capable of
 124 multiple frames, then `calendar-basic-setup' is called.
 125
 126 If PROMPT is non-nil, prompt for the month and year to use."
 127   (if (not (and (display-multi-frame-p)
 128                 (memq config '(calendar-only one-frame two-frames))))
 129       (calendar-basic-setup prompt)
 130     (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
 131     (unless (eq config 'calendar-only)
 132       (if (frame-live-p diary-frame) (delete-frame diary-frame)))
 133     (let ((calendar-view-diary-initially-flag (eq config 'one-frame))
 134           ;; For calendar-dedicate-diary in two-frames case.
 135           (pop-up-windows nil))
 136       (save-window-excursion
 137         ;; Do diary first so that calendar is always left current.
 138         (when (eq config 'two-frames)
 139           (calendar-frame-1
 140            (setq diary-frame (make-frame diary-frame-parameters)))
 141           (diary)
 142           (calendar-dedicate-diary))
 143         (calendar-frame-1
 144          (setq calendar-frame
 145                (make-frame (if (eq config 'one-frame)
 146                                calendar-and-diary-frame-parameters
 147                              calendar-frame-parameters))))
 148         (calendar-basic-setup prompt (not (eq config 'one-frame)))
 149         (set-window-buffer (selected-window) calendar-buffer)
 150         (set-window-dedicated-p (selected-window) t)
 151         (if (eq config 'one-frame)
 152             (calendar-dedicate-diary))))))
 153
 154
 155 ;;;###cal-autoload
 156 (defun calendar-one-frame-setup (&optional prompt)
 157   "Display calendar and diary in a single dedicated frame.
 158 See `calendar-frame-setup' for more information."
 159   (calendar-frame-setup 'one-frame prompt))
 160
 161 (make-obsolete 'calendar-one-frame-setup 'calendar-frame-setup "23.1")
 162
 163
 164 ;;;###cal-autoload
 165 (defun calendar-only-one-frame-setup (&optional prompt)
 166   "Display calendar in a dedicated frame.
 167 See `calendar-frame-setup' for more information."
 168   (calendar-frame-setup 'calendar-only prompt))
 169
 170 (make-obsolete 'calendar-only-one-frame-setup 'calendar-frame-setup "23.1")
 171
 172
 173 ;;;###cal-autoload
 174 (defun calendar-two-frame-setup (&optional prompt)
 175   "Display calendar and diary in separate, dedicated frames.
 176 See `calendar-frame-setup' for more information."
 177   (calendar-frame-setup 'two-frames prompt))
 178
 179 (make-obsolete 'calendar-two-frame-setup 'calendar-frame-setup "23.1")
 180
 181
 182 ;; Undocumented and probably useless.
 183 (defvar cal-x-load-hook nil
 184   "Hook run on loading of the `cal-x' package.")
 185 (make-obsolete-variable 'cal-x-load-hook "it will be removed in future." "23.1")
 186
 187 (run-hooks 'cal-x-load-hook)
 188
 189
 190 (provide 'cal-x)
 191
 192 ;; arch-tag: c6dbddca-ae84-442d-87fc-244b76e38e17
 193 ;;; cal-x.el ends here