Mercurial > hg > xemacs-beta

comparison lisp/syntax.el @ 444:576fb035e263 r21-2-37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents 3ecd8885ac67
children 7039e6323819
comparison
equal deleted inserted replaced
443:a8296e22da4e 444:576fb035e263
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details. 16 ;; General Public License for more details.
17 17
18 ;; You should have received a copy of the GNU General Public License 18 ;; You should have received a copy of the GNU General Public License
19 ;; along with XEmacs; see the file COPYING. If not, write to the 19 ;; along with XEmacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, 59 Temple Place - Suite 330, 20 ;; Free Software Foundation, 59 Temple Place - Suite 330,
21 ;; Boston, MA 02111-1307, USA. 21 ;; Boston, MA 02111-1307, USA.
22 22
23 ;;; Synched up with: FSF 19.28. 23 ;;; Synched up with: FSF 19.28.
24 24
145 ;; tough luck if you want to make space a paren! 145 ;; tough luck if you want to make space a paren!
146 (/= (aref string 1) ?\ )) 146 (/= (aref string 1) ?\ ))
147 (setq code (cons code (aref string 1)))) 147 (setq code (cons code (aref string 1))))
148 code)) 148 code))
149 149
150 (defun modify-syntax-entry (char-range spec &optional table) 150 (defun modify-syntax-entry (char-range spec &optional syntax-table)
151 "Set syntax for the characters CHAR-RANGE according to string SPEC. 151 "Set syntax for the characters CHAR-RANGE according to string SPEC.
152 CHAR-RANGE is a single character or a range of characters, 152 CHAR-RANGE is a single character or a range of characters,
153 as per `put-char-table'. 153 as per `put-char-table'.
154 The syntax is changed only for table TABLE, which defaults to 154 The syntax is changed only for SYNTAX-TABLE, which defaults to
155 the current buffer's syntax table. 155 the current buffer's syntax table.
156 The first character of SPEC should be one of the following: 156 The first character of SPEC should be one of the following:
157 Space whitespace syntax. w word constituent. 157 Space whitespace syntax. w word constituent.
158 _ symbol constituent. . punctuation. 158 _ symbol constituent. . punctuation.
159 \( open-parenthesis. \) close-parenthesis. 159 \( open-parenthesis. \) close-parenthesis.
179 p means C is a prefix character for `backward-prefix-chars'; 179 p means C is a prefix character for `backward-prefix-chars';
180 such characters are treated as whitespace when they occur 180 such characters are treated as whitespace when they occur
181 between expressions. 181 between expressions.
182 a means C is comment starter or comment ender for comment style a (default) 182 a means C is comment starter or comment ender for comment style a (default)
183 b means C is comment starter or comment ender for comment style b." 183 b means C is comment starter or comment ender for comment style b."
184 (interactive 184 (interactive
185 ;; I really don't know why this is interactive 185 ;; I really don't know why this is interactive
186 ;; help-form should at least be made useful while reading the second arg 186 ;; help-form should at least be made useful while reading the second arg
187 "cSet syntax for character: \nsSet syntax for %c to: ") 187 "cSet syntax for character: \nsSet syntax for %c to: ")
188 (cond ((syntax-table-p table)) 188 (simple-set-syntax-entry
189 ((not table) 189 char-range
190 (setq table (syntax-table))) 190 (syntax-string-to-code spec)
191 (t 191 (cond ((syntax-table-p syntax-table)
192 (setq table 192 syntax-table)
193 (wrong-type-argument 'syntax-table-p table)))) 193 ((null syntax-table)
194 (let ((code (syntax-string-to-code spec))) 194 (syntax-table))
195 (simple-set-syntax-entry char-range code table)) 195 (t
196 (wrong-type-argument 'syntax-table-p syntax-table))))
196 nil) 197 nil)
197 198
198 (defun map-syntax-table (__function __table &optional __range) 199 (defun map-syntax-table (__function __syntax_table &optional __range)
199 "Map FUNCTION over entries in syntax table TABLE, collapsing inheritance. 200 "Map FUNCTION over entries in SYNTAX-TABLE, collapsing inheritance.
200 This is similar to `map-char-table', but works only on syntax tables, and 201 This is similar to `map-char-table', but works only on syntax tables, and
201 collapses any entries that call for inheritance by invisibly substituting 202 collapses any entries that call for inheritance by invisibly substituting
202 the inherited values from the standard syntax table." 203 the inherited values from the standard syntax table."
203 (check-argument-type 'syntax-table-p __table) 204 (check-argument-type 'syntax-table-p __syntax_table)
204 (map-char-table #'(lambda (__key __value) 205 (map-char-table #'(lambda (__key __value)
205 (if (eq ?@ (char-syntax-from-code __value)) 206 (if (eq ?@ (char-syntax-from-code __value))
206 (map-char-table #'(lambda (__key __value) 207 (map-char-table #'(lambda (__key __value)
207 (funcall __function 208 (funcall __function
208 __key __value)) 209 __key __value))
209 (standard-syntax-table) 210 (standard-syntax-table)
210 __key) 211 __key)
211 (funcall __function __key __value))) 212 (funcall __function __key __value)))
212 __table __range)) 213 __syntax_table __range))
213 214
214 ;(defun test-xm () 215 ;(defun test-xm ()
215 ; (let ((o (copy-syntax-table)) 216 ; (let ((o (copy-syntax-table))
216 ; (n (copy-syntax-table)) 217 ; (n (copy-syntax-table))
217 ; (codes (syntax-designator-chars)) 218 ; (codes (syntax-designator-chars))