Initial revision

1 files changed, 61 insertions, 0 deletions

diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
new file mode 100644
index 00000000000..e8f370835f1
--- /dev/null
+++ b/lisp/vt100-led.el
@@ -0,0 +1,61 @@
+;; Functions for controlling the LEDs on VT-100 terminals & clones.
+;; Copyright (C) 1988 Free Software Foundation, Inc.
+
+;; 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 1, 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; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;; Written by Howard Gayle.
+
+(defvar led-state (make-vector 5 nil)
+   "The internal state of the LEDs.  Choices are nil, t, `flash.
+Element 0 is not used.")
+
+(defun led-flash (l)
+  "Flash LED l."
+  (aset led-state l 'flash)
+  (led-update))
+
+(defun led-off (&optional l)
+  "Turn off vt100 led number L.  With no argument, turn them all off."
+  (interactive "P")
+  (if l
+      (aset led-state (prefix-numeric-value l) nil)
+    (fillarray led-state nil))
+  (led-update))
+
+(defun led-on (l)
+  "Turn on LED l."
+  (aset led-state l t)
+  (led-update))
+
+(defun led-update ()
+  "Update the terminal's LEDs to reflect the internal state."
+  (let ((f "\e[?0")			; String to flash.
+	(o "\e[0")			; String for steady on.
+	(l 1))				; Current LED number.
+    (while (/= l 5)
+      (let ((s (aref led-state l)))
+	(cond
+	 ((eq s 'flash)
+	  (setq f (concat f ";" (int-to-string l))))
+	 (s
+	  (setq o (concat o ";" (int-to-string l))))))
+      (setq l (1+ l)))
+    (setq o (concat o "q" f "t"))
+    (send-string-to-terminal o)))
+
+(provide 'vt100-led)