Sync to HEAD
[bpt/emacs.git] / lisp / vt100-led.el
CommitLineData
55535639 1;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
76d7458e 2
58142744
ER
3;; Copyright (C) 1988 Free Software Foundation, Inc.
4
e5167999
ER
5;; Author: Howard Gayle
6;; Maintainer: FSF
6251ee24 7;; Keywords: hardware
e5167999 8
3b4a6e27
JB
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
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
3b4a6e27
JB
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
b578f267
EN
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
3b4a6e27 25
55535639
PJ
26;;; Commentary:
27
e5167999 28;;; Code:
3b4a6e27
JB
29
30(defvar led-state (make-vector 5 nil)
31 "The internal state of the LEDs. Choices are nil, t, `flash.
32Element 0 is not used.")
33
34(defun led-flash (l)
35 "Flash LED l."
36 (aset led-state l 'flash)
37 (led-update))
38
39(defun led-off (&optional l)
40 "Turn off vt100 led number L. With no argument, turn them all off."
41 (interactive "P")
42 (if l
43 (aset led-state (prefix-numeric-value l) nil)
44 (fillarray led-state nil))
45 (led-update))
46
47(defun led-on (l)
48 "Turn on LED l."
49 (aset led-state l t)
50 (led-update))
51
52(defun led-update ()
53 "Update the terminal's LEDs to reflect the internal state."
54 (let ((f "\e[?0") ; String to flash.
55 (o "\e[0") ; String for steady on.
56 (l 1)) ; Current LED number.
57 (while (/= l 5)
58 (let ((s (aref led-state l)))
59 (cond
60 ((eq s 'flash)
61 (setq f (concat f ";" (int-to-string l))))
62 (s
63 (setq o (concat o ";" (int-to-string l))))))
64 (setq l (1+ l)))
65 (setq o (concat o "q" f "t"))
66 (send-string-to-terminal o)))
67
68(provide 'vt100-led)
76d7458e 69
6b61353c 70;;; arch-tag: 346e6480-5e31-4234-aafe-257cea4a36d1
76d7458e 71;;; vt100-led.el ends here