home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / utils / symbol-syntax.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  3.1 KB  |  101 lines

  1. ;; Created by: JBW, JBW@_CORTEZ
  2. ;; Created on: Wed Jun 20 15:15:34 1990
  3. ;; Last modified by: Joe Wells, jbw@dodge
  4. ;; Last modified on: Mon Jul  2 18:23:23 1990
  5. ;; Filename: symbol-syntax.el
  6. ;; Purpose: find chars with symbol syntax
  7.  
  8. (defvar symbol-syntax-table-alist nil)
  9. ;;  '((c-mode-syntax-table)
  10. ;;    (emacs-lisp-mode-syntax-table)
  11. ;;    (lisp-mode-syntax-table)
  12. ;;    (text-mode-syntax-table)))
  13.  
  14. (defun update-symbol-syntax-table-alist ()
  15.   (let ((alist symbol-syntax-table-alist)
  16.     item)
  17.     (while (consp alist)
  18.       (cond ((null (car alist))
  19.          (error "Missing alist item"))
  20.         ((null (car (car alist)))
  21.          (error "Alist item with null car"))
  22.         ;; this functionality not used
  23.         ((symbolp (setq item (car (car alist))))
  24.          (or (null (cdr (car alist)))
  25.          (error "Alist item expected to have null cdr"))
  26.          (while (symbolp item)
  27.            (setq item (symbol-value item)))
  28.          (setcar (car alist) item)))
  29.       (cond ((not (syntax-table-p (car (car alist))))
  30.          (error "Alist item car expected to be symbol table"))
  31.         ((null (cdr (car alist)))
  32.          (setcdr (car alist)
  33.              (make-symbol-syntax-table (car (car alist))))))
  34.       (setq alist (cdr alist)))))
  35.  
  36. (defun get-symbol-syntax-table (norm-table)
  37.   (let (result)
  38.     (if (setq result (assq norm-table symbol-syntax-table-alist))
  39.     nil
  40.       (update-symbol-syntax-table-alist)
  41.       (if (setq result (assq norm-table symbol-syntax-table-alist))
  42.       nil
  43.     (setq symbol-syntax-table-alist
  44.           (cons (list norm-table)
  45.             symbol-syntax-table-alist))
  46.     (update-symbol-syntax-table-alist)
  47.     (or (setq result (assq norm-table symbol-syntax-table-alist))
  48.         (error "Syntax table missing from symbol-syntax-table-alist"))))
  49.     (or (setq result (cdr result))
  50.     (error "Alist item has null cdr"))
  51.     (or (syntax-table-p result)
  52.     (error "Non-syntax-table item in alist"))
  53.     result))
  54.  
  55. (defun make-symbol-syntax-table (in-table)
  56.   (let ((osyn (syntax-table))
  57.     (out-table (copy-syntax-table in-table))
  58.     (i 0)
  59.     (syntax nil))
  60.     (while (< i 256)
  61.       (setq syntax (aref out-table i))
  62.       (if (eq 3 (logand 255 syntax))
  63.       (aset out-table i (logior 2 (logand (lognot 255) syntax))))
  64.       (setq i (1+ i)))
  65.     out-table))
  66.  
  67. ;; stuff for examining contents of syntax tables
  68. ;;(show-chars-with-syntax
  69. ;; '(c-mode-syntax-table
  70. ;;   emacs-lisp-mode-syntax-table
  71. ;;   lisp-mode-syntax-table
  72. ;;   text-mode-syntax-table)
  73. ;; ?_)
  74.  
  75. (defun show-chars-with-syntax (tables syntax)
  76.   (let ((osyn (syntax-table))
  77.     (schars nil))
  78.     (unwind-protect
  79.     (while (consp tables)
  80.       (let* ((chars nil)
  81.          (table-symbol (car tables))
  82.          (table table-symbol)
  83.          (i 0))
  84.         (or (symbolp table-symbol)
  85.         (error "bad argument non-symbol"))
  86.         (while (symbolp table)
  87.           (setq table (symbol-value table)))
  88.         (set-syntax-table table)
  89.         (while (< i 256)
  90.           (if (eq syntax (char-syntax i))
  91.           (setq chars (cons (format "%c" i) chars)))
  92.           (setq i (1+ i)))
  93.         (setq schars (cons (list table-symbol
  94.                      (mapconcat 'identity (nreverse chars) ""))
  95.                    schars)))
  96.       (setq tables (cdr tables)))
  97.       (set-syntax-table osyn))
  98.     (nreverse schars)))
  99.  
  100. (provide 'symbol-syntax)
  101.