|
428
|
1 ;;; symbol-syntax.el --- find chars with symbol syntax
|
|
|
2
|
|
|
3 ;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1995 Sun Microsystems.
|
|
|
5
|
|
|
6 ;; Author: JBW, JBW@_CORTEZ
|
|
|
7 ;; Created: Wed Jun 20 15:15:34 1990
|
|
|
8 ;; Maintainer: XEmacs Development Team
|
|
|
9 ;; Keywords: matching
|
|
|
10
|
|
|
11 ;; This file is part of XEmacs.
|
|
|
12
|
|
|
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)
|
|
|
16 ;; any later version.
|
|
|
17
|
|
|
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.
|
|
|
22
|
|
|
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.
|
|
|
27
|
|
|
28 ;;; Synched up with: Not in FSF.
|
|
|
29
|
|
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;; Last modified by: Ben Wing, ben@xemacs.org
|
|
|
33 ;; Last modified on: Mon Oct 2 02:32:05 GMT 1995
|
|
|
34
|
|
|
35 ;;; Code:
|
|
|
36
|
|
|
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)))
|
|
|
42
|
|
|
43 (defun update-symbol-syntax-table-alist ()
|
|
|
44 (let ((alist symbol-syntax-table-alist)
|
|
|
45 item)
|
|
|
46 (while (consp 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"))
|
|
|
55 (while (symbolp item)
|
|
|
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)))
|
|
|
61 (setcdr (car alist)
|
|
|
62 (make-symbol-syntax-table (car (car alist))))))
|
|
|
63 (setq alist (cdr alist)))))
|
|
|
64
|
|
|
65 (defun get-symbol-syntax-table (norm-table)
|
|
|
66 (let (result)
|
|
|
67 (if (setq result (assq norm-table symbol-syntax-table-alist))
|
|
|
68 nil
|
|
|
69 (update-symbol-syntax-table-alist)
|
|
|
70 (if (setq result (assq norm-table symbol-syntax-table-alist))
|
|
|
71 nil
|
|
|
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"))
|
|
|
82 result))
|
|
|
83
|
|
|
84 (defun make-symbol-syntax-table (in-table)
|
|
|
85 (let ((out-table (copy-syntax-table in-table)))
|
|
|
86 (map-syntax-table
|
|
|
87 #'(lambda (key value)
|
|
|
88 (if (eq ?_ (char-syntax-from-code value))
|
|
|
89 (put-char-table key (set-char-syntax-in-code value ?w)
|
|
|
90 out-table))
|
|
|
91 nil)
|
|
|
92 out-table)
|
|
|
93 out-table))
|
|
|
94
|
|
|
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)
|
|
|
101 ;; ?_)
|
|
|
102
|
|
|
103 (defun show-chars-with-syntax (tables syntax)
|
|
|
104 (let ((schars nil))
|
|
|
105 (unwind-protect
|
|
|
106 (while (consp tables)
|
|
|
107 (let* ((chars nil)
|
|
|
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)))
|
|
|
114 (map-syntax-table
|
|
|
115 #'(lambda (key value)
|
|
|
116 (if (eq syntax (char-syntax-from-code value))
|
|
|
117 (setq chars (cons key chars)))
|
|
|
118 nil)
|
|
|
119 table)
|
|
|
120 (setq schars (cons (list table-symbol (nreverse chars))
|
|
|
121 schars)))
|
|
|
122 (setq tables (cdr tables))))
|
|
|
123 (nreverse schars)))
|
|
|
124
|
|
|
125 (provide 'symbol-syntax)
|
|
|
126
|
|
|
127 ;;; symbol-syntax.el ends here
|
