1 ;;; symbol-syntax.el --- find chars with symbol syntax
3 ;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Sun Microsystems.
6 ;; Author: JBW, JBW@_CORTEZ
7 ;; Created: Wed Jun 20 15:15:34 1990
8 ;; Maintainer: XEmacs Development Team
11 ;; This file is part of XEmacs.
13 ;; XEmacs is free software; you can redistribute it and/or modify it
14 ;; under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; XEmacs is distributed in the hope that it will be useful, but
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with XEmacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
28 ;;; Synched up with: Not in FSF.
32 ;; Last modified by: Ben Wing, ben@xemacs.org
33 ;; Last modified on: Mon Oct 2 02:32:05 GMT 1995
37 (defvar symbol-syntax-table-alist nil)
38 ;; '((c-mode-syntax-table)
39 ;; (emacs-lisp-mode-syntax-table)
40 ;; (lisp-mode-syntax-table)
41 ;; (text-mode-syntax-table)))
43 (defun update-symbol-syntax-table-alist ()
44 (let ((alist symbol-syntax-table-alist)
47 (cond ((null (car alist))
48 (error "Missing alist item"))
49 ((null (car (car alist)))
50 (error "Alist item with null car"))
51 ;; this functionality not used
52 ((symbolp (setq item (car (car alist))))
53 (or (null (cdr (car alist)))
54 (error "Alist item expected to have null cdr"))
56 (setq item (symbol-value item)))
57 (setcar (car alist) item)))
58 (cond ((not (syntax-table-p (car (car alist))))
59 (error "Alist item car expected to be symbol table"))
60 ((null (cdr (car alist)))
62 (make-symbol-syntax-table (car (car alist))))))
63 (setq alist (cdr alist)))))
65 (defun get-symbol-syntax-table (norm-table)
67 (if (setq result (assq norm-table symbol-syntax-table-alist))
69 (update-symbol-syntax-table-alist)
70 (if (setq result (assq norm-table symbol-syntax-table-alist))
72 (setq symbol-syntax-table-alist
73 (cons (list norm-table)
74 symbol-syntax-table-alist))
75 (update-symbol-syntax-table-alist)
76 (or (setq result (assq norm-table symbol-syntax-table-alist))
77 (error "Syntax table missing from symbol-syntax-table-alist"))))
78 (or (setq result (cdr result))
79 (error "Alist item has null cdr"))
80 (or (syntax-table-p result)
81 (error "Non-syntax-table item in alist"))
84 (defun make-symbol-syntax-table (in-table)
85 (let ((out-table (copy-syntax-table in-table)))
88 (if (eq ?_ (char-syntax-from-code value))
89 (put-char-table key (set-char-syntax-in-code value ?w)
95 ;; stuff for examining contents of syntax tables
96 ;;(show-chars-with-syntax
97 ;; '(c-mode-syntax-table
98 ;; emacs-lisp-mode-syntax-table
99 ;; lisp-mode-syntax-table
100 ;; text-mode-syntax-table)
103 (defun show-chars-with-syntax (tables syntax)
106 (while (consp tables)
108 (table-symbol (car tables))
109 (table table-symbol))
110 (or (symbolp table-symbol)
111 (error "bad argument non-symbol"))
112 (while (symbolp table)
113 (setq table (symbol-value table)))
115 #'(lambda (key value)
116 (if (eq syntax (char-syntax-from-code value))
117 (setq chars (cons key chars)))
120 (setq schars (cons (list table-symbol (nreverse chars))
122 (setq tables (cdr tables))))
125 (provide 'symbol-syntax)
127 ;;; symbol-syntax.el ends here