home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / utils / symbol-syntax.el < prev    next >
Encoding:
Text File  |  1995-04-17  |  3.9 KB  |  122 lines
  1. ;;; symbol-syntax.el --- find chars with symbol syntax
  2.  
  3. ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Created by: JBW, JBW@_CORTEZ
  6. ;; Created on: Wed Jun 20 15:15:34 1990
  7. ;; Last modified by: Joe Wells, jbw@dodge
  8. ;; Last modified on: Mon Jul  2 18:23:23 1990
  9. ;; Filename: symbol-syntax.el
  10. ;; Keywords: matching
  11.  
  12. ;; This file is part of XEmacs.
  13.  
  14. ;; XEmacs is free software; you can redistribute it and/or modify it
  15. ;; under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation; either version 2, or (at your option)
  17. ;; any later version.
  18.  
  19. ;; XEmacs is distributed in the hope that it will be useful, but
  20. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22. ;; General Public License for more details.
  23.  
  24. ;; You should have received a copy of the GNU General Public License
  25. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  26. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27.  
  28.  
  29. (defvar symbol-syntax-table-alist nil)
  30. ;;  '((c-mode-syntax-table)
  31. ;;    (emacs-lisp-mode-syntax-table)
  32. ;;    (lisp-mode-syntax-table)
  33. ;;    (text-mode-syntax-table)))
  34.  
  35. (defun update-symbol-syntax-table-alist ()
  36.   (let ((alist symbol-syntax-table-alist)
  37.     item)
  38.     (while (consp alist)
  39.       (cond ((null (car alist))
  40.          (error "Missing alist item"))
  41.         ((null (car (car alist)))
  42.          (error "Alist item with null car"))
  43.         ;; this functionality not used
  44.         ((symbolp (setq item (car (car alist))))
  45.          (or (null (cdr (car alist)))
  46.          (error "Alist item expected to have null cdr"))
  47.          (while (symbolp item)
  48.            (setq item (symbol-value item)))
  49.          (setcar (car alist) item)))
  50.       (cond ((not (syntax-table-p (car (car alist))))
  51.          (error "Alist item car expected to be symbol table"))
  52.         ((null (cdr (car alist)))
  53.          (setcdr (car alist)
  54.              (make-symbol-syntax-table (car (car alist))))))
  55.       (setq alist (cdr alist)))))
  56.  
  57. (defun get-symbol-syntax-table (norm-table)
  58.   (let (result)
  59.     (if (setq result (assq norm-table symbol-syntax-table-alist))
  60.     nil
  61.       (update-symbol-syntax-table-alist)
  62.       (if (setq result (assq norm-table symbol-syntax-table-alist))
  63.       nil
  64.     (setq symbol-syntax-table-alist
  65.           (cons (list norm-table)
  66.             symbol-syntax-table-alist))
  67.     (update-symbol-syntax-table-alist)
  68.     (or (setq result (assq norm-table symbol-syntax-table-alist))
  69.         (error "Syntax table missing from symbol-syntax-table-alist"))))
  70.     (or (setq result (cdr result))
  71.     (error "Alist item has null cdr"))
  72.     (or (syntax-table-p result)
  73.     (error "Non-syntax-table item in alist"))
  74.     result))
  75.  
  76. (defun make-symbol-syntax-table (in-table)
  77.   (let ((osyn (syntax-table))
  78.     (out-table (copy-syntax-table in-table))
  79.     (i 0)
  80.     (syntax nil))
  81.     (while (< i 256)
  82.       (setq syntax (aref out-table i))
  83.       (if (eq 3 (logand 255 syntax))
  84.       (aset out-table i (logior 2 (logand (lognot 255) syntax))))
  85.       (setq i (1+ i)))
  86.     out-table))
  87.  
  88. ;; stuff for examining contents of syntax tables
  89. ;;(show-chars-with-syntax
  90. ;; '(c-mode-syntax-table
  91. ;;   emacs-lisp-mode-syntax-table
  92. ;;   lisp-mode-syntax-table
  93. ;;   text-mode-syntax-table)
  94. ;; ?_)
  95.  
  96. (defun show-chars-with-syntax (tables syntax)
  97.   (let ((osyn (syntax-table))
  98.     (schars nil))
  99.     (unwind-protect
  100.     (while (consp tables)
  101.       (let* ((chars nil)
  102.          (table-symbol (car tables))
  103.          (table table-symbol)
  104.          (i 0))
  105.         (or (symbolp table-symbol)
  106.         (error "bad argument non-symbol"))
  107.         (while (symbolp table)
  108.           (setq table (symbol-value table)))
  109.         (set-syntax-table table)
  110.         (while (< i 256)
  111.           (if (eq syntax (char-syntax i))
  112.           (setq chars (cons (format "%c" i) chars)))
  113.           (setq i (1+ i)))
  114.         (setq schars (cons (list table-symbol
  115.                      (mapconcat 'identity (nreverse chars) ""))
  116.                    schars)))
  117.       (setq tables (cdr tables)))
  118.       (set-syntax-table osyn))
  119.     (nreverse schars)))
  120.  
  121. (provide 'symbol-syntax)
  122.