home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / mim-syntax.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  3KB  |  93 lines
  1. ;; Syntax checker for Mim (MDL).
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3. ;; Principal author K. Shane Hartman
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23. (require 'mim-mode)
  24.  
  25. (defun slow-syntax-check-mim ()
  26.   "Check Mim syntax slowly.
  27. Points out the context of the error, if the syntax is incorrect."
  28.   (interactive)
  29.   (message "checking syntax...")
  30.   (let ((stop (point-max)) point-stack current last-bracket whoops last-point)
  31.     (save-excursion
  32.       (goto-char (point-min))
  33.       (while (and (not whoops)
  34.           (re-search-forward "\\s(\\|\\s)\\|\"\\|[\\]" stop t))
  35.     (setq current (preceding-char))
  36.     (cond ((= current ?\")
  37.            (condition-case nil
  38.            (progn (re-search-forward "[^\\]\"")
  39.               (setq current nil))
  40.          (error (setq whoops (point)))))
  41.           ((= current ?\\)
  42.            (condition-case nil (forward-char 1) (error nil)))
  43.           ((= (char-syntax current) ?\))
  44.            (if (or (not last-bracket)
  45.                (not (= (logand (lsh (aref (syntax-table) last-bracket) -8)
  46.                        ?\177)
  47.                    current)))
  48.            (setq whoops (point))
  49.          (setq last-point (car point-stack))
  50.          (setq last-bracket (if last-point (char-after (1- last-point))))
  51.          (setq point-stack (cdr point-stack))))
  52.           (t
  53.            (if last-point (setq point-stack (cons last-point point-stack)))
  54.            (setq last-point (point))
  55.            (setq last-bracket current)))))
  56.     (cond ((not (or whoops last-point))
  57.        (message "Syntax correct"))
  58.       (whoops
  59.        (goto-char whoops)
  60.        (cond ((equal current ?\")
  61.           (error "Unterminated string"))
  62.          ((not last-point)
  63.           (error "Extraneous %s" (char-to-string current)))
  64.          (t
  65.           (error "Mismatched %s with %s"
  66.                (save-excursion
  67.                  (setq whoops (1- (point)))
  68.                  (goto-char (1- last-point))
  69.                  (buffer-substring (point)
  70.                            (min (progn (end-of-line) (point))
  71.                             whoops)))
  72.                (char-to-string current)))))
  73.       (t
  74.        (goto-char last-point)
  75.        (error "Unmatched %s" (char-to-string last-bracket))))))
  76.       
  77. (defun fast-syntax-check-mim ()
  78.   "Checks Mim syntax quickly.
  79. Answers correct or incorrect, cannot point out the error context."
  80.   (interactive)
  81.   (save-excursion
  82.     (goto-char (point-min))
  83.     (let (state)
  84.       (while (and (not (eobp))
  85.           (equal (car (setq state (parse-partial-sexp (point) (point-max) 0)))
  86.              0)))
  87.       (if (equal (car state) 0)
  88.       (message "Syntax correct")
  89.     (error "Syntax incorrect")))))
  90.  
  91.  
  92.     
  93.