semibalanced.el / semibalanced.el

;; semibalanced.el
;; Based on balanced.el. Provides a modifier to major modes that helps
;; in keeping parenthesis etc balanced, but tries to keep out of the
;; way a bit more than balanced.el.  See the documentation-string for
;; ``semibalanced-on'' for details.  After putting this file somewhere
;; in your load-path, A not-bad thing to do with this package is:

;; (require 'semibalanced)
;; (add-hook 'scheme-mode-hook 'semibalanced-on)

;; ------------------------------

;; This file provides the package named ``semibalanced''.  When
;; compiled, if it contains macros, it should require itself to be
;; loaded before the program is compiled, thus the following require
;; statement.

;; Changed to allow the insertion of unbalanced parens.

(provide 'semibalanced)
(require 'semibalanced)

;; I want a menu-bar option for toggling semibalanced mode.

(global-set-key [menu-bar tools balance]
		'("Semi-Balance Parens" . semibalanced-toggle))

;; I can't believe for-each isn't defined in emacs lisp.

(defun for-each (f ls)
  (if (null ls)
    (funcall f (car ls))
    (for-each f (cdr ls))))

;; semibalanced-modes is an association-list of major-mode names to lists
;; of (key binding) pairs.  It is used both to check whether we have
;; reset the keys for a particular mode, as well as used for unsetting
;; the key modifications.

(defvar semibalanced-modes '()
  "*The table of semibalanced major modes.  Each entry is of the form

	(major-mode-name (key old-binding) ...)

and is used to reset the major mode when balancing is turned off.")

;; scans through the keymap and finds all the
;; goodies, then sets up the proper keys.

(defun semibalanced-on ()
  "Changes a number of key bindings in the current major mode:

  * ``open parenthesis''-type keys (the exact keys depend on the major
    mode) insert both opening and closing characters, and ``close
    parenthesis''-type keys simply move to the nearest closing
    character (not necessarily matching the key typed).  
  * Meta-``open'' and ``close'' are rebound to simply insert the
    corresponding character.

If the ``open parenthesis''-type keys are given a numeric argument,
they will wrap their open and close around that many items.  For
example, in lisp modes, if the point is at -!- in:  

      (if (null? x) -!-(printf 3) hi)

then ``Esc 2 ('' will result in

      (if (null? x) (-!-(printf 3) hi))"
  (let ((already-seen (assq major-mode semibalanced-modes)))
    (when (not already-seen)
      (let* ((acc '())
             (localmap (current-local-map))
             (index 0))
        (while (< index 256)
          (let ((syn (char-syntax index)))
            (when (or (= syn ?\() (= syn ?\)))
              (let* ((mainkey (format "%c" index))
                     (metakey (vector (list 'meta index)))
                     (mainkeyb (local-key-binding mainkey))
                     (metakeyb (local-key-binding metakey)))
                (local-set-key mainkey
                               (if (= syn ?\()
                (local-set-key metakey 'self-insert-unmeta)
                (setq acc
                      (cons (list mainkey mainkeyb)
                            (cons (list metakey metakeyb)
          (setq index (+ index 1)))
        (setq semibalanced-modes
              (cons (cons major-mode acc) semibalanced-modes))))))

(defun semibalanced-off ()
  "Restores major modes which were previously made ``semibalanced'' 
by the command ``semibalanced-on'' to its previous ``unsemibalanced'' 
  (let ((thing (assq major-mode semibalanced-modes)))
    (and thing
	   (for-each (function
		      (lambda (x) (local-set-key (car x) (car (cdr x)))))
		     (cdr thing))
	   (setq semibalanced-modes (delq thing semibalanced-modes))))))

(defun semibalanced-toggle ()
  "Toggles ``semibalanced'' in the current major mode"
  (let ((thing (assq major-mode semibalanced-modes)))
    (if thing

;; Lastly, a few functions needed to be defined.

(defun semibalanced-char-isws (c)
  "Is character c a whitespace character?"
  (or (char-equal c ?\ )
      (char-equal c ?\t)
      (char-equal c ?\n)))

(defun semibalanced-line-next-non-ws ()
  "Return the next non-whitespace character on the current line or nil."
  (let ((cc (char-after)))
    (if (and cc (char-isws cc))
          (if (re-search-forward "[^[:space:]]" (save-excursion (end-of-line) (point)) t)

(defun semibalanced-up-list-single-if-matching ()
  "Move past the next closing parens, if it matches the previous opening parens. If not, error."
  (let ((target-point (point)))
      (goto-char (or (scan-lists (point) 1 1) (buffer-end arg)))
      ;; here we have gone past the next closing parens or have signaled an
      ;; error if one isn't found
      (unless (save-excursion
                (let ((prev-paren (char-before)))
                  (goto-char (scan-sexps (point) -1))
                  (let ((expect (matching-paren prev-paren)))
                    (equal (char-after) expect))))
        (error "Foo! Unmatched parens"))
      (set 'target-point (point)))
    (goto-char target-point)))

(defun semibalanced-open (arg)
  "Put parens (or whatever) around next ARG sexps."
  (interactive "P")
  (let* ((arg (if arg (prefix-numeric-value arg) 0))
         (ch last-input-char)
         (endch (cdr (aref (syntax-table) ch))))
    (if (= (preceding-char) ?\\)
        (insert ch)
      (or (zerop arg) (skip-chars-forward " \t"))
      (insert ch)
        (or (zerop arg) (forward-sexp arg))
        (insert endch)))))

(defun semibalanced-close ()
  "Just move past the next closing paren, don't reindent."
  (if (= (preceding-char) ?\\) 
      (insert last-input-char)
    (let ((nc (semibalanced-line-next-non-ws)))
      (if (or (null nc)
              (not (= (char-syntax nc) ?\))))
          (insert last-input-char)
        (condition-case nil
          (error (insert last-input-event))))))

;; ---- end semibalanced.el