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