view lisp/vt100-led.el @ 83310:e58cb448e07c

Merged from miles@gnu.org--gnu-2005 (patch 80-82, 350-422) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-350
author Karoly Lorentey <lorentey@elte.hu>
date Wed, 15 Jun 2005 12:57:51 +0000
parents 695cf19ef79e
children 6fb026ad601f 375f2633d815
line wrap: on
line source

;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones

;; Copyright (C) 1988 Free Software Foundation, Inc.

;; Author: Howard Gayle
;; Maintainer: FSF
;; Keywords: hardware

;; 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 2, 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Code:

(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)

;;; arch-tag: 346e6480-5e31-4234-aafe-257cea4a36d1
;;; vt100-led.el ends here