Mercurial > hg > xemacs-beta

comparison lisp/utils/symbol-syntax.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 0293115a14e9
children
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
75 (or (syntax-table-p result) 75 (or (syntax-table-p result)
76 (error "Non-syntax-table item in alist")) 76 (error "Non-syntax-table item in alist"))
77 result)) 77 result))
78 78
79 (defun make-symbol-syntax-table (in-table) 79 (defun make-symbol-syntax-table (in-table)
80 (let ((osyn (syntax-table)) 80 (let ((out-table (copy-syntax-table in-table)))
81 (out-table (copy-syntax-table in-table)) 81 (map-syntax-table
82 (i 0) 82 #'(lambda (key value)
83 (syntax nil)) 83 (if (eq ?_ (char-syntax-from-code value))
84 (while (< i 256) 84 (put-char-table key (set-char-syntax-in-code value ?w)
85 (setq syntax (aref out-table i)) 85 out-table))
86 (if (eq 3 (logand 255 syntax)) 86 nil)
87 (aset out-table i (logior 2 (logand (lognot 255) syntax)))) 87 out-table)
88 (setq i (1+ i)))
89 out-table)) 88 out-table))
90 89
91 ;; stuff for examining contents of syntax tables 90 ;; stuff for examining contents of syntax tables
92 ;;(show-chars-with-syntax 91 ;;(show-chars-with-syntax
93 ;; '(c-mode-syntax-table 92 ;; '(c-mode-syntax-table
107 (i 0)) 106 (i 0))
108 (or (symbolp table-symbol) 107 (or (symbolp table-symbol)
109 (error "bad argument non-symbol")) 108 (error "bad argument non-symbol"))
110 (while (symbolp table) 109 (while (symbolp table)
111 (setq table (symbol-value table))) 110 (setq table (symbol-value table)))
112 (set-syntax-table table) 111 (map-syntax-table
113 (while (< i 256) 112 #'(lambda (key value)
114 (if (eq syntax (char-syntax i)) 113 (if (eq syntax (char-syntax-from-code value))
115 (setq chars (cons (format "%c" i) chars))) 114 (setq chars (cons key chars)))
116 (setq i (1+ i))) 115 nil)
117 (setq schars (cons (list table-symbol 116 table)
118 (mapconcat 'identity (nreverse chars) "")) 117 (setq schars (cons (list table-symbol (nreverse chars))
119 schars))) 118 schars)))
120 (setq tables (cdr tables))) 119 (setq tables (cdr tables))))
121 (set-syntax-table osyn))
122 (nreverse schars))) 120 (nreverse schars)))
123 121
124 (provide 'symbol-syntax) 122 (provide 'symbol-syntax)