lisp/calendar/cal-x.el

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