cgit.sxemacs.org Git - packages/blob - xemacs-packages/speedbar/bigclock.el

   1 ;;; bigclock --- A great big clock
   2
   3 ;;; Copyright (C) 2000 Free Software Foundation
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: amusement
   7 ;; X-RCS: $Id: bigclock.el,v 1.4 2005/09/30 20:25:35 zappo Exp $
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Display a big clock in a special frame.
  29
  30 (require 'dframe)
  31
  32 ;;; Code:
  33 (defgroup bigclock nil
  34   "Faces used in dframe."
  35   :prefix "bigclock-"
  36   :group 'bigclock)
  37
  38 (defcustom bigclock-frame-parameters
  39   '((minibuffer . nil)
  40     (width . 9)
  41     (height . 2)
  42     (border-width . 0)
  43     (menu-bar-lines . 0)
  44     (unsplittable . t)
  45     (font . "-*-courier-medium-r-normal-*-*-320-*-*-m-*-iso8859-1"))
  46   "Frame parameters for the big clock."
  47   :group 'bigclock
  48   :type '(repeat (sexp :tag "Parameter:")))
  49
  50 (defcustom bigclock-update-flag dframe-have-timer-flag
  51   "Non-nil means the clock will be able to update."
  52   :group 'bigclock
  53   :type 'boolean)
  54
  55 (defvar bigclock-key-map
  56   (let ((km (make-sparse-keymap)))
  57     (dframe-update-keymap km)
  58     km)
  59   "Keymap used in the big clock.")
  60
  61 (defvar bigclock-buffer nil
  62   "Bigclocks buffer.")
  63
  64 (defvar bigclock-frame nil
  65   "Bigclock's frame.")
  66
  67 (defvar bigclock-cached-frame nil
  68   "Bigclock's cached frame.")
  69
  70 (defcustom bigclock-before-delete-hook nil
  71   "Hooks called before bigclock is deleted."
  72   :group 'bigclock
  73   :type 'hook)
  74
  75 (defcustom bigclock-before-popup-hook nil
  76   "Hooks called before poping up the bigclock frame."
  77   :group 'bigclock
  78   :type 'hook)
  79
  80 (defcustom bigclock-after-create-hook nil
  81   "Hooks called after creating the bigclock frame."
  82   :group 'bigclock
  83   :type 'hook)
  84
  85 (defcustom bigclock-mode-hook nil
  86   "Hook run when a bigclock buffer is created."
  87   :group 'bigclock
  88   :type 'hook)
  89
  90 (defalias 'bigclock 'bigclock-frame-mode)
  91 (defun bigclock-frame-mode (&optional arg)
  92   "Enable or disable bigclock.
  93 Optional argument ARG enables or disables the bigclock frame."
  94   (interactive "P")
  95   ;; Get the buffer to play with
  96   (if (not (buffer-live-p bigclock-buffer))
  97       (save-excursion
  98         (setq bigclock-buffer (get-buffer-create " BIGCLOCK"))
  99         (set-buffer bigclock-buffer)
 100         (bigclock-mode)))
 101   ;; Do the frame thing
 102   (dframe-frame-mode arg
 103                      'bigclock-frame
 104                      'bigclock-cached-frame
 105                      'bigclock-buffer
 106                      "Bigclock"
 107                      #'bigclock-frame-mode
 108                      (if dframe-xemacsp
 109                          bigclock-frame-plist
 110                        bigclock-frame-parameters)
 111                      bigclock-before-delete-hook
 112                      bigclock-before-popup-hook
 113                      bigclock-after-create-hook)
 114   ;; Start up the timer
 115   (if (not bigclock-frame)
 116       (dframe-set-timer nil #'bigclock-timer-fn 'bigclock-update-flag)
 117     (dframe-set-timer 60 #'bigclock-timer-fn 'bigclock-update-flag)
 118     ))
 119
 120 (defun bigclock-get-focus ()
 121   "Change frame focus to or from the bigclock frame.
 122 If the selected frame is not bigclock, then bigclock frame is
 123 selected.  If the bigclock frame is active, then select the attached frame."
 124   (interactive)
 125   (dframe-get-focus 'bigclock-frame 'bigclock-frame-mode))
 126
 127 (defun bigclock-mode ()
 128   "Set the current buffer to be in BIGCLOCK mode.
 129 \\{bigclock-key-map}"
 130   ;; NOT interactive
 131   (save-excursion
 132     (kill-all-local-variables)
 133     (setq major-mode 'bigclock-mode)
 134     (setq mode-name "BigClock")
 135     (setq font-lock-keywords nil) ;; no font-locking please
 136     (setq truncate-lines t)
 137     (use-local-map bigclock-key-map)
 138     (make-local-variable 'frame-title-format)
 139     (setq frame-title-format "Bigclock "))
 140     (toggle-read-only 1)
 141     (setq mode-line-format "")
 142     ;; Add in our dframe hooks.
 143     (setq dframe-track-mouse-function nil
 144           dframe-help-echo-function nil
 145           dframe-mouse-click-function nil
 146           dframe-mouse-position-function nil)
 147     ;;no auto-show for Emacs
 148     (run-hooks 'bigclock-mode-hook))
 149
 150 (defun bigclock-timer-fn ()
 151   "Run whenever Emacs is idle to update bigclock."
 152   (if (or (not bigclock-frame)
 153           (not (frame-live-p bigclock-frame)))
 154       (dframe-set-timer nil 'bigclock-timer-fn 'bigclock-update-flag)
 155     (save-excursion
 156       (set-buffer bigclock-buffer)
 157       (toggle-read-only -1)
 158       (erase-buffer)
 159       (insert (format-time-string "%2I:%M %p" (current-time))))))
 160
 161
 162 (provide 'bigclock)
 163
 164 ;;; bigclock.el ends here