Mercurial > hg > xemacs-beta

comparison lisp/packages/blink-cursor.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 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; blink-cursor.el --- Blink the cursor on or off
2
3 ;; Copyright (C) 1996 Ben Wing.
4
5 ;; Keywords: display
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23 ;;; Synched up with: Not in FSF.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (defvar blink-cursor-last-selected-window nil)
30 (defvar blink-cursor-lost-focus nil)
31
32 (defun blink-cursor-callback (foo)
33 (let ((inhibit-quit t)
34 (window (selected-window)))
35 (if blink-cursor-lost-focus
36 nil
37 (or blink-cursor-last-selected-window
38 (setq blink-cursor-last-selected-window window))
39 (if (eq window blink-cursor-last-selected-window)
40 (set-specifier text-cursor-visible-p
41 (not (specifier-instance text-cursor-visible-p
42 window))
43 window)
44 (remove-specifier text-cursor-visible-p
45 blink-cursor-last-selected-window)
46 (setq blink-cursor-last-selected-window window)
47 (set-specifier text-cursor-visible-p nil window)))))
48
49 (defun blink-cursor-reenable-cursor ()
50 (if blink-cursor-last-selected-window
51 (progn
52 (remove-specifier text-cursor-visible-p
53 blink-cursor-last-selected-window)
54 (setq blink-cursor-last-selected-window nil))))
55
56 (defun blink-cursor-deselect-frame-hook ()
57 (blink-cursor-reenable-cursor)
58 (setq blink-cursor-lost-focus t))
59
60 (defun blink-cursor-select-frame-hook ()
61 (setq blink-cursor-lost-focus nil))
62
63 (add-hook 'deselect-frame-hook 'blink-cursor-deselect-frame-hook)
64 (add-hook 'select-frame-hook 'blink-cursor-select-frame-hook)
65
66 (defvar blink-cursor-timeout 1.0)
67 (defvar blink-cursor-timeout-id nil)
68 (defvar blink-cursor-mode nil)
69
70 ;;;###autoload
71 (defun blink-cursor-mode (&optional timeout)
72 "Enable or disable a blinking cursor.
73 If TIMEOUT is nil, toggle on or off.
74 If TIMEOUT is t, enable with the previous timeout value.
75 If TIMEOUT is 0, disable.
76 If TIMEOUT is greater than 0, then the cursor will blink once
77 each TIMEOUT secs (can be a float)."
78 (interactive)
79 (cond ((not timeout)
80 (setq timeout blink-cursor-timeout)
81 (setq blink-cursor-mode (not blink-cursor-mode)))
82 ((eq timeout t)
83 (setq timeout blink-cursor-timeout)
84 (setq blink-cursor-mode t))
85 ((<= timeout 0)
86 (setq blink-cursor-mode nil))
87 (t
88 (setq blink-cursor-timeout timeout)
89 (setq blink-cursor-mode t)))
90 (if blink-cursor-timeout-id
91 (progn
92 (disable-timeout blink-cursor-timeout-id)
93 (blink-cursor-reenable-cursor)
94 (setq blink-cursor-timeout-id nil)))
95 (if blink-cursor-mode
96 (setq blink-cursor-timeout-id
97 (add-timeout (/ (float timeout) 2) 'blink-cursor-callback nil
98 (/ (float timeout) 2)))))