cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-prn.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-prn.el --
   4 ;;; ILISP paren handling.
   5 ;;;
   6 ;;; This file is part of ILISP.
   7 ;;; Please refer to the file COPYING for copyrights and licensing
   8 ;;; information.
   9 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  10 ;;; of present and past contributors.
  11 ;;;
  12 ;;; $Id: ilisp-prn.el,v 1.3 2001-07-02 09:40:48 youngs Exp $
  13
  14
  15 ;;;%Unbalanced parentheses
  16 (defun lisp-skip (end)
  17   "Skip past whitespace, comments, backslashed characters and strings.
  18 The operation is done in the current buffer as long as we are before END.
  19 This does move the point."
  20   (if (< (point) end)
  21       (let ((comment (and comment-start (string-to-char comment-start)))
  22             (done nil)
  23             char)
  24         (while (and (< (point) end)
  25                     (not done))
  26           (skip-chars-forward "\n\t " end)
  27           (setq char (char-after (point)))
  28           (cond ((eq char ?\")
  29                  (forward-sexp))
  30                 ((eq char comment)
  31                  (forward-char)
  32                  (skip-chars-forward "^\n" end))
  33                 ((eq char ?\\)
  34                  (forward-char 2))
  35                 (t (setq done t)))))))
  36
  37 ;;;
  38 (defun lisp-count-pairs (begin end left-delimiter right-delimiter)
  39   "Return the number of top-level pairs of LEFT-DELIMITER and RIGHT-DELIMITER.
  40 Counting is done only between BEGIN and END.  If they don't match, the point
  41 will be placed on the offending entry."
  42   (let ((old-point (point))
  43         (sexp 0)
  44         left)
  45     (goto-char begin)
  46     (lisp-skip end)
  47     (while (< (point) end)
  48       (let ((char (char-after (point))))
  49         (cond ((or (eq char left-delimiter)
  50                    ;; For things other than lists
  51                    (eq (char-after (1- (point))) ?\n))
  52                (setq sexp (1+ sexp))
  53                (if (condition-case ()
  54                        (progn (forward-sexp) nil)
  55                      (error t))
  56                    (error "Extra %s" (char-to-string left-delimiter))))
  57               ((eq char right-delimiter)
  58                (error "Extra %s" (char-to-string right-delimiter)))
  59               ((< (point) end) (forward-char))))
  60       (lisp-skip end))
  61     (goto-char old-point)
  62     sexp))
  63
  64 ;;;
  65 (defun find-unbalanced-region-lisp (start end)
  66   "Go to the point where LEFT-DELIMITER and RIGHT-DELIMITER become unbalanced.
  67 Point will be on the offending delimiter within the region."
  68   (interactive "r")
  69   (lisp-count-pairs start end
  70                     (string-to-char left-delimiter)
  71                     (string-to-char right-delimiter))
  72   (if (not ilisp-complete) (progn (beep) (message "Delimiters balance"))))
  73
  74 ;;;
  75 (defun find-unbalanced-lisp (arg)
  76   "Go to the point where LEFT-DELIMITER and RIGHT-DELIMITER become unbalanced.
  77 Point will be on the offending delimiter in the buffer.
  78 If called with a prefix, use the current region."
  79   (interactive "P")
  80   (if arg
  81       (call-interactively 'find-unbalanced-region-lisp)
  82       (find-unbalanced-region-lisp (point-min) (point-max))))
  83
  84 ;;; end of file -- ilisp-prn.el --