home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / capslock.el < prev    next >
Encoding:
Text File  |  1992-05-17  |  3.5 KB  |  102 lines
  1. ;; capslock.el -- quick and dirty caps-lock minor mode
  2. ;;                for lusers with DIN keyboards (Shift lock!)
  3. ;;
  4. ;; LCD Archive Entry:
  5. ;; capslock|Eberhard Mattes|mattes@azu.informatik.uni-stuttgart.de|
  6. ;; Reverse Shift state for letter keys|
  7. ;; 92-05-15|1.0|~/misc/capslock.el.Z|
  8. ;;
  9. ;; Version 1.0  15-May-1992  Author: mattes@azu.informatik.uni-stuttgart.de
  10. ;;
  11. ;; Copyright (c) 1992 by Eberhard Mattes
  12. ;;
  13. ;; This program is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License version 1 as
  15. ;; published by the Free Software Foundation.
  16. ;;
  17. ;; This program is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21. ;;
  22. ;; This file is not part of GNU Emacs.
  23. ;;
  24. ;; Comments:
  25. ;;
  26. ;;   Caps-lock mode is disabled in the minibuffer.
  27. ;;
  28. ;;   Unfortunately, every character inserted with caps-lock-self-insert
  29. ;;   gets a separate entry on the undo stack. Fixing this seems to require
  30. ;;   changes to Emacs itself. No other problems known.
  31. ;;
  32. ;;   Works with 8-bit character sets and with 8-bit keymaps.
  33. ;;
  34. ;;   Maybe a local keymap should be used.
  35. ;;
  36. ;;   If you find a simpler solution, please tell me.
  37. ;;
  38. ;; Usage:
  39. ;;
  40. ;;   caps-lock-mode      toggle caps-lock mode
  41. ;;   caps-lock-disable   clean-up
  42. ;;
  43. (provide 'capslock)
  44.  
  45. (defvar caps-lock-mode nil
  46.   "*t enables caps-lock mode.
  47. Setting it makes it local to the current buffer.")
  48.  
  49. (make-variable-buffer-local 'caps-lock-mode)
  50.  
  51. (defun caps-lock-mode (arg)
  52.   "Toggle caps-lock mode.
  53. With arg, turn caps-lock mode on iff arg is positive.
  54. In caps-lock mode, characters typed in are translated to upper case."
  55.   (interactive "P")
  56.   (and (setq caps-lock-mode
  57.             (if (null arg) (not caps-lock-mode)
  58.               (> (prefix-numeric-value arg) 0)))
  59.        (eq (elt global-map ?a) 'self-insert-command)
  60.        (caps-lock-init 'self-insert-command 'caps-lock-self-insert))
  61.   (set-buffer-modified-p (buffer-modified-p)))
  62.  
  63. (defun caps-lock-self-insert (arg)
  64.   "Insert a character according to the setting of the caps-lock variable.
  65. Prefix arg is repeat-count.
  66. If caps-lock is nil, the character is inserted as-is. Otherwise, the
  67. case of the character is changed (if possible) before inserting.
  68. While the cursor is in the minibuffer, caps-lock mode is disabled."
  69.   (interactive "*p")
  70.   (and caps-lock-mode
  71.        (not (eq (selected-window) (minibuffer-window)))
  72.        (if (< last-command-char 0)      ; seems to be signed
  73.            (setq last-command-char (+ last-command-char 256))
  74.          t)
  75.        (setq last-command-char
  76.              (if (= (downcase last-command-char) last-command-char)
  77.                  (upcase last-command-char)
  78.                (downcase last-command-char))))
  79.   (self-insert-command arg))
  80.  
  81. (or (assq 'caps-lock-mode minor-mode-alist)
  82.     (setq minor-mode-alist
  83.           (cons '(caps-lock-mode " Caps") minor-mode-alist)))
  84.  
  85. (defun caps-lock-disable ()
  86.   "Turn off caps-lock mode and restore global key map."
  87.   (interactive)
  88.   (setq caps-lock-mode nil)
  89.   (caps-lock-init 'caps-lock-self-insert 'self-insert-command)
  90.   (set-buffer-modified-p (buffer-modified-p)))
  91.  
  92. (defun caps-lock-init (from to)
  93.   (let ((key 0) (len (length global-map)))
  94.     (while (< key len)
  95.       (and (eq (elt global-map key) from)
  96.            (or (/= key (downcase key)) (/= key (upcase key)))
  97.            (global-set-key (char-to-string key) to))
  98.       (setq key (1+ key)))))
  99.  
  100. ;; end of capslock.el
  101.  
  102.