emacs/lisp/calendar/cal-x.el

149 lines
5.7 KiB
EmacsLisp

;;; cal-x.el --- calendar windows in dedicated frames -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2001-2024 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: calendar
;; Human-Keywords: calendar, dedicated frames
;; Package: calendar
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; See calendar.el.
;;; Code:
(require 'calendar)
(defcustom diary-frame-parameters
'((name . "Diary") (title . "Diary") (height . 10) (width . 80)
(unsplittable . t) (minibuffer . nil))
"Parameters of the diary frame, if the diary is in its own frame.
Relevant if `calendar-setup' has the value `two-frames'."
:type 'alist
:options '((name string) (title string) (height integer) (width integer)
(unsplittable boolean) (minibuffer boolean)
(vertical-scroll-bars boolean))
:group 'calendar)
(defcustom calendar-frame-parameters
'((name . "Calendar") (title . "Calendar") (height . 10) (width . 80)
(unsplittable . t) (minibuffer . nil) (vertical-scroll-bars . nil))
"Parameters of the calendar frame, if the calendar is in a separate frame.
Relevant if `calendar-setup' has the value `calendar-only' or `two-frames'."
:type 'alist
:options '((name string) (title string) (height integer) (width integer)
(unsplittable boolean) (minibuffer boolean)
(vertical-scroll-bars boolean))
:group 'calendar)
(defcustom calendar-and-diary-frame-parameters
'((name . "Calendar") (title . "Calendar") (height . 28) (width . 80)
(minibuffer . nil))
"Parameters of the frame that displays both the calendar and the diary.
Relevant if `calendar-setup' has the value `one-frame'."
:type 'alist
:options '((name string) (title string) (height integer) (width integer)
(unsplittable boolean) (minibuffer boolean)
(vertical-scroll-bars boolean))
:group 'calendar)
(defcustom calendar-after-frame-setup-hook nil
"List of functions to be run after creating a calendar and/or diary frame."
:type 'hook
:group 'calendar-hooks)
;;; End of user options.
(defvar calendar-frame nil
"Frame in which the calendar was last displayed.")
(defvar diary-frame nil
"Frame in which the diary was last displayed.")
(defun calendar-frame-1 (frame)
"Subroutine used by `calendar-frame-setup'.
Runs `calendar-after-frame-setup-hook', selects frame, iconifies if needed."
(run-hooks 'calendar-after-frame-setup-hook)
(select-frame frame)
(if (eq 'icon (cdr (assoc 'visibility (frame-parameters frame))))
(iconify-or-deiconify-frame)))
;; c-d-d is only called after (diary) has been run.
(defvar diary-display-function)
(defun calendar-dedicate-diary ()
"Display and dedicate the window associated with the diary buffer."
(set-window-dedicated-p
(display-buffer
(if (eq diary-display-function 'diary-fancy-display)
(progn
;; If there are no diary entries, there won't be a buffer
;; to dedicate, so make a basic one.
(or (get-buffer diary-fancy-buffer)
(calendar-in-read-only-buffer diary-fancy-buffer
(calendar-set-mode-line "Diary Entries")))
diary-fancy-buffer)
(get-file-buffer diary-file)))
t))
;;;###cal-autoload
(defun calendar-frame-setup (config &optional prompt)
"Display the calendar, and optionally the diary, in a separate frame.
CONFIG should be one of:
`calendar-only' - just the calendar, no diary
`one-frame' - calendar and diary in a single frame
`two-frames' - calendar and diary each in a separate frame
If CONFIG has any other value, or if the display is not capable of
multiple frames, then `calendar-basic-setup' is called.
If PROMPT is non-nil, prompt for the month and year to use."
(if (not (and (display-multi-frame-p)
(memq config '(calendar-only one-frame two-frames))))
(calendar-basic-setup prompt)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
(unless (eq config 'calendar-only)
(if (frame-live-p diary-frame) (delete-frame diary-frame)))
(let ((calendar-view-diary-initially-flag (eq config 'one-frame))
;; For calendar-dedicate-diary in two-frames case.
(pop-up-windows nil))
(save-window-excursion
;; Do diary first so that calendar is always left current.
(when (eq config 'two-frames)
(calendar-frame-1
(setq diary-frame (make-frame diary-frame-parameters)))
(diary)
(calendar-dedicate-diary))
(calendar-frame-1
(setq calendar-frame
(make-frame (if (eq config 'one-frame)
calendar-and-diary-frame-parameters
calendar-frame-parameters))))
(calendar-basic-setup prompt (not (eq config 'one-frame)))
(set-window-buffer (selected-window) calendar-buffer)
(set-window-dedicated-p (selected-window) t)
(if (eq config 'one-frame)
(calendar-dedicate-diary))))))
(provide 'cal-x)
;;; cal-x.el ends here