cgit.sxemacs.org Git - sxemacs/blob - lisp/symbol-syntax.el

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