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