Mercurial > hg > xemacs-beta

comparison lisp/symbol-syntax.el @ 219:262b8bb4a523 r20-4b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b8
author cvs
date Mon, 13 Aug 2007 10:09:35 +0200
parents
children 70ad99077275
comparison
equal deleted inserted replaced
218:c9f226976f56 219:262b8bb4a523
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, wing@666.com
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 ((osyn (syntax-table))
105 (schars nil))
106 (unwind-protect
107 (while (consp tables)
108 (let* ((chars nil)
109 (table-symbol (car tables))
110 (table table-symbol)
111 (i 0))
112 (or (symbolp table-symbol)
113 (error "bad argument non-symbol"))
114 (while (symbolp table)
115 (setq table (symbol-value table)))
116 (map-syntax-table
117 #'(lambda (key value)
118 (if (eq syntax (char-syntax-from-code value))
119 (setq chars (cons key chars)))
120 nil)
121 table)
122 (setq schars (cons (list table-symbol (nreverse chars))
123 schars)))
124 (setq tables (cdr tables))))
125 (nreverse schars)))
126
127 (provide 'symbol-syntax)
128
129 ;;; symbol-syntax.el ends here