Mercurial > hg > xemacs-beta

comparison lisp/syntax.el @ 3067:2f31c7aa4e96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-11-13 10:57:59 by ben] create describe-char-table syntax.el: Convert describe-syntax-table to more general describe-char-table. (Will also be used by display tables.) Create new describe-syntax-table, compatible with old function, that uses describe-char-table. diagnose.el: Conditionalize `sort-numeric-fields' on when-fboundp.
author ben
date Sun, 13 Nov 2005 10:58:00 +0000
parents 7039e6323819
children a78d697ccd2c
comparison
equal deleted inserted replaced
3066:a88e6130a523 3067:2f31c7aa4e96
1 ;; syntax.el --- Syntax-table hacking stuff, moved from syntax.c 1 ;; syntax.el --- Syntax-table hacking stuff, moved from syntax.c
2 2
3 ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Sun Microsystems. 4 ;; Copyright (C) 1995 Sun Microsystems.
5 ;; Copyright (C) 2005 Ben Wing.
5 6
6 ;; This file is part of XEmacs. 7 ;; This file is part of XEmacs.
7 8
8 ;; XEmacs is free software; you can redistribute it and/or modify it 9 ;; XEmacs is free software; you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by 10 ;; under the terms of the GNU General Public License as published by
236 ; (error "%s" 237 ; (error "%s"
237 ; (format "fucked with %S: %x %x" 238 ; (format "fucked with %S: %x %x"
238 ; spec (aref o ?a) (aref n ?a)))))))) 239 ; spec (aref o ?a) (aref n ?a))))))))
239 240
240 241
241 (defun describe-syntax-table (table stream) 242 (defun describe-char-table (table mapper describe-value stream)
243 "Describe char-table TABLE, outputting to STREAM.
244 MAPPER maps over the table and should be `map-char-table' or
245 `map-syntax-table'. DESCRIBE-VALUE is a function of two arguments,
246 VALUE and STREAM, and should output a description of VALUE."
242 (let (first-char 247 (let (first-char
243 last-char 248 last-char
244 prev-val 249 prev-val
245 (describe-one 250 (describe-one
246 (if (featurep 'mule) 251 (if (featurep 'mule)
270 (t 275 (t
271 (princ (format "%s .. %s\t" 276 (princ (format "%s .. %s\t"
272 (text-char-description first) 277 (text-char-description first)
273 (text-char-description last)) 278 (text-char-description last))
274 stream)))) 279 stream))))
275 (describe-syntax-code value stream)) 280 (funcall describe-value value stream))
276 #'(lambda (first last value stream) 281 #'(lambda (first last value stream)
277 (let* ((tem (text-char-description first)) 282 (let* ((tem (text-char-description first))
278 (pos (length tem)) 283 (pos (length tem))
279 ;;(limit (cond ((numberp ctl-arrow) ctl-arrow) 284 ;;(limit (cond ((numberp ctl-arrow) ctl-arrow)
280 ;; ((memq ctl-arrow '(t nil)) 256) 285 ;; ((memq ctl-arrow '(t nil)) 256)
288 (princ tem stream) 293 (princ tem stream)
289 (setq pos (+ pos (length tem) 4)))) 294 (setq pos (+ pos (length tem) 4))))
290 (while (progn (write-char ?\ stream) 295 (while (progn (write-char ?\ stream)
291 (setq pos (1+ pos)) 296 (setq pos (1+ pos))
292 (< pos 16)))) 297 (< pos 16))))
293 (describe-syntax-code value stream))))) 298 (funcall describe-value value stream)))))
294 (map-syntax-table 299 (funcall mapper
295 #'(lambda (range value) 300 #'(lambda (range value)
296 (cond 301 (cond
297 ((not first-char) 302 ((not first-char)
298 (setq first-char range 303 (setq first-char range
299 last-char range 304 last-char range
318 prev-val value))) 323 prev-val value)))
319 nil) 324 nil)
320 table) 325 table)
321 (if first-char 326 (if first-char
322 (funcall describe-one first-char last-char prev-val stream)))) 327 (funcall describe-one first-char last-char prev-val stream))))
328
329 (defun describe-syntax-table (table stream)
330 "Output a description of TABLE (a syntax table) to STREAM."
331 (describe-char-table table 'map-syntax-table 'describe-syntax-code stream))
323 332
324 (defun describe-syntax-code (code stream) 333 (defun describe-syntax-code (code stream)
325 (let ((match (and (consp code) (cdr code))) 334 (let ((match (and (consp code) (cdr code)))
326 (invalid (gettext "**invalid**")) ;(empty "") ;constants 335 (invalid (gettext "**invalid**")) ;(empty "") ;constants
327 (standard-output (or stream standard-output)) 336 (standard-output (or stream standard-output))