[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
shift-lock.el --- Electric Shift Lock Mode
From: |
John Paul Wallington |
Subject: |
shift-lock.el --- Electric Shift Lock Mode |
Date: |
Sun, 18 May 2008 03:31:07 +0100 |
User-agent: |
Microsoft Gnus Express, Build 511.221 |
Here is a minor mode, inspired by ZWEI Electric Shift Lock Mode on the
LISPM, that uppercases everything except comments and strings.
Please send me bugs and improvements. Share and enjoy!
;;; shift-lock.el --- Electric Shift Lock Mode
;; Copyright (C) 2008 John Paul Wallington
;; Author: John Paul Wallington <address@hidden>
;; Keywords: convenience emulations lisp tools
;; Version: 1
;; This file isn't part of GNU Emacs.
;; This file 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 3 of the License, or
;; (at your option) any later version.
;; This file 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. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Inspired by ZWEI Electric Shift Lock Mode on the LISPM,
;; `shift-lock-mode' is a minor mode that uppercases everything except
;; comments and strings. By default it applies to new ordinary text
;; characters that you type. Alternatively, frobbing the user option
;; `shift-lock-upcase-existing-text' causes existing buffer text to be
;; uppercased except, of course, for comments and strings. By default
;; uppercasing is done according to `ascii-case-table'; an alternative
;; case table variable can be specified via the user option
;; `shift-lock-case-table'.
;;; Code:
(defgroup shift-lock nil
"Electric Shift Lock Mode.
A minor mode that uppercases everything except comments and strings."
:group 'convenience
:group 'editing
:group 'lisp
:group 'programming
:link '(emacs-commentary-link "shift-lock")
:prefix 'shift-lock)
(defcustom shift-lock-upcase-existing-text nil
"Non-nil means `shift-lock-mode' should uppercase existing buffer text.
Comments and strings aren't uppercased. If the buffer text isn't
syntactically valid then it will give up gracefully."
:type 'boolean
:group 'shift-lock)
(defcustom shift-lock-case-table 'ascii-case-table
"Case table that `shift-lock-mode' uses to convert to uppercase."
:type 'variable
:group 'shift-lock)
(defsubst shift-lock-looking-at-comment-p (&optional pt)
"Return non-nil if text after point PT is within a comment."
(nth 4 (syntax-ppss pt)))
(defsubst shift-lock-looking-at-string-p (&optional pt)
"Return non-nil if text after point PT is within a string."
(nth 3 (syntax-ppss pt)))
(defun shift-lock-unbalanced-p (begin end)
"Return non nil if region is syntactically unbalanced."
(let ((unbalanced nil))
(condition-case data
(scan-sexps begin end)
(scan-error (setq unbalanced t))
(error (cond ((eq 'scan-error (car data))
(setq unbalanced t))
(t (signal (car data) (cdr data))))))
unbalanced))
(defun shift-lock-upcase-region (begin end)
"Convert the region to upper case except for strings and comments."
(interactive "r")
(with-case-table (symbol-value shift-lock-case-table)
(save-excursion
(if (shift-lock-unbalanced-p begin end)
(message "Unbalanced expression")
(let ((pt begin)
(upcase-p nil))
(goto-char pt)
(while (< (point) end)
(setq pt (point))
(setq upcase-p (not (or (shift-lock-looking-at-comment-p)
(shift-lock-looking-at-string-p))))
(skip-syntax-forward (string (char-syntax (char-after))))
(if upcase-p
(upcase-region pt (point)))
(setq upcase-p nil)))))))
(defun shift-lock-upcase-buffer ()
"Convert the current buffer to upper case except for strings and comments."
(interactive)
(shift-lock-upcase-region (point-min) (point-max)))
(defun shift-lock-self-insert ()
"Insert the character you type, upcased if within a string or comment."
(interactive)
(with-case-table (symbol-value shift-lock-case-table)
(insert (if (or (shift-lock-looking-at-comment-p)
(shift-lock-looking-at-string-p))
last-command-char
(upcase last-command-char)))))
(defvar shift-lock-mode-map
(let ((map (make-keymap)))
(if (fboundp 'command-remapping)
(define-key map [remap self-insert-command] 'shift-lock-self-insert)
(substitute-key-definition 'self-insert-command
'shift-lock-self-insert
map))
map)
"Minor mode keymap for `shift-lock-mode'.")
(define-minor-mode shift-lock-mode
"Toggle Electric Shift Lock mode.
With arg, turn Electric Shift Lock mode off iff arg is a
non-positive number; if arg is nil, toggle Electric Shift Lock
mode; anything else turns Electric Shift Lock mode on.
Electric Shift Lock mode is a minor mode that uppercases the
characters that you type unless they are in comments or strings."
nil " Shift" 'shift-lock-mode-map
(if shift-lock-upcase-existing-text
(shift-lock-upcase-buffer)))
(defalias 'electric-shift-lock-mode 'shift-lock-mode)
(provide 'shift-lock)
;;; shift-lock.el ends here