vt100-led.el 1.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869
  1. ;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
  2. ;; Copyright (C) 1988, 2001-2012 Free Software Foundation, Inc.
  3. ;; Author: Howard Gayle
  4. ;; Maintainer: FSF
  5. ;; Keywords: hardware
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;;; Code:
  19. (defvar led-state (make-vector 5 nil)
  20. "The internal state of the LEDs. Choices are nil, t, `flash'.
  21. Element 0 is not used.")
  22. (defun led-flash (l)
  23. "Flash LED l."
  24. (aset led-state l 'flash)
  25. (led-update))
  26. (defun led-off (&optional l)
  27. "Turn off vt100 led number L. With no argument, turn them all off."
  28. (interactive "P")
  29. (if l
  30. (aset led-state (prefix-numeric-value l) nil)
  31. (fillarray led-state nil))
  32. (led-update))
  33. (defun led-on (l)
  34. "Turn on LED L."
  35. (aset led-state l t)
  36. (led-update))
  37. (defun led-update ()
  38. "Update the terminal's LEDs to reflect the internal state."
  39. (let ((f "\e[?0") ; String to flash.
  40. (o "\e[0") ; String for steady on.
  41. (l 1)) ; Current LED number.
  42. (while (/= l 5)
  43. (let ((s (aref led-state l)))
  44. (cond
  45. ((eq s 'flash)
  46. (setq f (concat f ";" (int-to-string l))))
  47. (s
  48. (setq o (concat o ";" (int-to-string l))))))
  49. (setq l (1+ l)))
  50. (setq o (concat o "q" f "t"))
  51. (send-string-to-terminal o)))
  52. (provide 'vt100-led)
  53. ;;; vt100-led.el ends here