annotate lisp/syntax.el @ 4844:91b3d00e717f

Various cleanups for Dynarr code, from Unicode-internal ws dynarr.c: Add comment explaining Dynarr_largest() use. dynarr.c: In Dynarr_insert_many(), don't call Dynarr_resize() unless we actually need to resize, and note that an assert() that we are inserting at or below the current end could be wrong if code wants to access stuff between `len' and `largest'. dynarr.c: Don't just Dynarr_resize() to the right size; instead use Dynarr_reset() then Dynarr_add_many(), so that the 'len' and 'largest' and such get set properly. dynarr.c, faces.c, gutter.c, lisp.h, lread.c, lrecord.h, redisplay-output.c, redisplay.c: Rename Dynarr member 'cur' to 'len' since it's the length of the dynarr, not really a pointer to a "current insertion point". Use type_checking_assert() instead of just assert() in some places. Add additional assertions (Dynarr_verify*()) to check that we're being given positions within range. Use them in Dynarr_at, Dynarr_atp, etc. New Dynarr_atp_allow_end() for retrieving a pointer to a position that might be the element past the last one. New Dynarr_past_lastp() to retrieve a pointer to the position past the last one, using Dynarr_atp_allow_end(). Change code appropriately to use it. Rename Dynarr_end() to Dynarr_lastp() (pointer to the last element) for clarity, and change code appropriately to use it. Change code appropriately to use Dynarr_begin(). Rewrite Dynarr_add_many(). New version can accept a NULL pointer to mean "reserve space but don't put anything in it". Used by stack_like_malloc().
author Ben Wing <ben@xemacs.org>
date Wed, 13 Jan 2010 04:07:42 -0600
parents fd36a980d701
children 99e465e2da2e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;; syntax.el --- Syntax-table hacking stuff, moved from syntax.c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1993, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Sun Microsystems.
3067
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
5 ;; Copyright (C) 2005 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
20 ;; along with XEmacs; see the file COPYING. If not, write to the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; Free Software Foundation, 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; Boston, MA 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;;; Synched up with: FSF 19.28.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;; Note: FSF does not have a file syntax.el. This stuff is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; in syntax.c. See comments there about not merging past 19.28.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;; Significantly hacked upon by Ben Wing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 (defun make-syntax-table (&optional oldtable)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 "Return a new syntax table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 It inherits all characters from the standard syntax table."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 (make-char-table 'syntax))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
4468
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
42 (defun syntax-after (pos)
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
43 "Return the raw syntax of the char after POS.
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
44 If POS is outside the buffer's accessible portion, return nil."
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
45 (unless (or (< pos (point-min)) (>= pos (point-max)))
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
46 (let ((st (if lookup-syntax-properties
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
47 (get-char-property pos 'syntax-table))))
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
48 (char-syntax (char-after pos) (or st (syntax-table))))))
a78d697ccd2c Import and extend GNU's descr-text.el, supporting prefix argument for C-x =
Aidan Kehoe <kehoea@parhasard.net>
parents: 3067
diff changeset
49
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 (defun simple-set-syntax-entry (char spec table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 (put-char-table char spec table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 (defun char-syntax-from-code (code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 "Extract the syntax designator from the internal syntax code CODE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 CODE is the value actually contained in the syntax table."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 (if (consp code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 (setq code (car code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 (aref (syntax-designator-chars) (logand code 127)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 (defun set-char-syntax-in-code (code desig)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 "Return a new internal syntax code whose syntax designator is DESIG.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Other characteristics are the same as in CODE."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 (let ((newcode (if (consp code) (car code) code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 (setq newcode (logior (string-match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 (regexp-quote (char-to-string desig))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (syntax-designator-chars))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 (logand newcode (lognot 127))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (if (consp code) (cons newcode (cdr code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 newcode)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 (defun syntax-code-to-string (code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 "Return a string equivalent to internal syntax code CODE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 The string can be passed to `modify-syntax-entry'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 If CODE is invalid, return nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 (let ((match (and (consp code) (cdr code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 (codes (syntax-designator-chars)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 (if (consp code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 (setq code (car code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 (if (or (not (integerp code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 (> (logand code 127) (length codes)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (with-output-to-string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 (let* ((spec (elt codes (logand code 127)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 (b3 (lsh code -16))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 (start1 (/= 0 (logand b3 128))) ;logtest!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 (start1b (/= 0 (logand b3 64)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 (start2 (/= 0 (logand b3 32)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (start2b (/= 0 (logand b3 16)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 (end1 (/= 0 (logand b3 8)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 (end1b (/= 0 (logand b3 4)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 (end2 (/= 0 (logand b3 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (end2b (/= 0 (logand b3 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 (prefix (/= 0 (logand code 128)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 (single-char-p (or (= spec ?<) (= spec ?>)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 (write-char spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (write-char (if match match 32))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ;;; (if start1 (if single-char-p (write-char ?a) (write-char ?1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 (if start1 (if single-char-p (write-char ? ) (write-char ?1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 (if start2 (write-char ?2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 ;;; (if end1 (if single-char-p (write-char ?a) (write-char ?3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (if end1 (if single-char-p (write-char ? ) (write-char ?3)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (if end2 (write-char ?4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (if start1b (if single-char-p (write-char ?b) (write-char ?5)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 (if start2b (write-char ?6))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 (if end1b (if single-char-p (write-char ?b) (write-char ?7)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (if end2b (write-char ?8))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 (if prefix (write-char ?p)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 (defun syntax-string-to-code (string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 "Return the internal syntax code equivalent to STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 STRING should be something acceptable as the second argument to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 `modify-syntax-entry'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 If STRING is invalid, signal an error."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 (let* ((bflag nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 (b3 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (ch0 (aref string 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 (len (length string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 (code (string-match (regexp-quote (char-to-string ch0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 (syntax-designator-chars)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 (i 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 ch)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 (or code
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (error "Invalid syntax designator: %S" string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 (while (< i len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (setq ch (aref string i))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (incf i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (case ch
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 (?1 (setq b3 (logior b3 128)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (?2 (setq b3 (logior b3 32)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 (?3 (setq b3 (logior b3 8)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 (?4 (setq b3 (logior b3 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 (?5 (setq b3 (logior b3 64)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 (?6 (setq b3 (logior b3 16)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 (?7 (setq b3 (logior b3 4)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (?8 (setq b3 (logior b3 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (?a (case ch0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 (?< (setq b3 (logior b3 128)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 (?> (setq b3 (logior b3 8)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 (?b (case ch0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 (?< (setq b3 (logior b3 64) bflag t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 (?> (setq b3 (logior b3 4) bflag t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 (?p (setq code (logior code (lsh 1 7))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 (?\ nil) ;; ignore for compatibility
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 (otherwise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (error "Invalid syntax description flag: %S" string))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 ;; default single char style if `b' has not been seen
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 (if (not bflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 (case ch0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (?< (setq b3 (logior b3 128)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (?> (setq b3 (logior b3 8)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 (setq code (logior code (lsh b3 16)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (if (and (> len 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 ;; tough luck if you want to make space a paren!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (/= (aref string 1) ?\ ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (setq code (cons code (aref string 1))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 code))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
159 (defun modify-syntax-entry (char-range spec &optional syntax-table)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 "Set syntax for the characters CHAR-RANGE according to string SPEC.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 CHAR-RANGE is a single character or a range of characters,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 as per `put-char-table'.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
163 The syntax is changed only for SYNTAX-TABLE, which defaults to
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 the current buffer's syntax table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 The first character of SPEC should be one of the following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 Space whitespace syntax. w word constituent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 _ symbol constituent. . punctuation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 \( open-parenthesis. \) close-parenthesis.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 \" string quote. \\ character-quote.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 $ paired delimiter. ' expression quote or prefix operator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 < comment starter. > comment ender.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 / character-quote. @ inherit from `standard-syntax-table'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 Only single-character comment start and end sequences are represented thus.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Two-character sequences are represented as described below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 The second character of SPEC is the matching parenthesis,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 used only if the first character is `(' or `)'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 Any additional characters are flags.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 Defined flags are the characters 1, 2, 3, 4, 5, 6, 7, 8, p, a, and b.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 1 means C is the first of a two-char comment start sequence of style a.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 2 means C is the second character of such a sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 3 means C is the first of a two-char comment end sequence of style a.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 4 means C is the second character of such a sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 5 means C is the first of a two-char comment start sequence of style b.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 6 means C is the second character of such a sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 7 means C is the first of a two-char comment end sequence of style b.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 8 means C is the second character of such a sequence.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 p means C is a prefix character for `backward-prefix-chars';
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 such characters are treated as whitespace when they occur
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 between expressions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 a means C is comment starter or comment ender for comment style a (default)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 b means C is comment starter or comment ender for comment style b."
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
193 (interactive
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 ;; I really don't know why this is interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 ;; help-form should at least be made useful while reading the second arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 "cSet syntax for character: \nsSet syntax for %c to: ")
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
197 (simple-set-syntax-entry
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
198 char-range
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
199 (syntax-string-to-code spec)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
200 (cond ((syntax-table-p syntax-table)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
201 syntax-table)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
202 ((null syntax-table)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
203 (syntax-table))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
204 (t
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 428
diff changeset
205 (wrong-type-argument 'syntax-table-p syntax-table))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
4806
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
208 ((macro
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
209 . (lambda (map-syntax-definition)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
210 "Replace the variable names in MAP-SYNTAX-DEFINITION with uninterned
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
211 symbols, at byte-compile time. This avoids the risk of variable names
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
212 within the functions called from MAP-SYNTAX-DEFINITION being shared with
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
213 MAP-SYNTAX-DEFINITION, and as such subject to modification, one of the
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
214 common downsides of dynamic scope."
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
215 (nsublis
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
216 '((syntax-table . #:syntax-table)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
217 (m-s-function . #:function)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
218 (range . #:range)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
219 (key . #:key)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
220 (value . #:value))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
221 map-syntax-definition)))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
222 (defun map-syntax-table (m-s-function syntax-table &optional range)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
223 "Map FUNCTION over entries in SYNTAX-TABLE, collapsing inheritance.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 This is similar to `map-char-table', but works only on syntax tables, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 collapses any entries that call for inheritance by invisibly substituting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 the inherited values from the standard syntax table."
4806
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
227 (check-argument-type 'syntax-table-p syntax-table)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
228 (map-char-table #'(lambda (key value)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
229 (if (eq ?@ (char-syntax-from-code value))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
230 (map-char-table
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
231 #'(lambda (key value)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
232 (funcall m-s-function key value))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
233 (standard-syntax-table)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
234 key)
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
235 (funcall m-s-function key value)))
fd36a980d701 Use uninterned symbols in various information-hiding contexts.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4468
diff changeset
236 syntax-table range)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 ;(defun test-xm ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 ; (let ((o (copy-syntax-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 ; (n (copy-syntax-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 ; (codes (syntax-designator-chars))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 ; (flags "12345678abp"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 ; (while t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 ; (let ((spec (concat (char-to-string (elt codes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 ; (random (length codes))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 ; (if (= (random 4) 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 ; "b"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 ; " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 ; (let* ((n (random 4))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 ; (s (make-string n 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 ; (while (> n 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ; (setq n (1- n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 ; (aset s n (aref flags (random (length flags)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 ; s))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 ; (message "%S..." spec)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 ; (modify-syntax-entry ?a spec o)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 ; (xmodify-syntax-entry ?a spec n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 ; (or (= (aref o ?a) (aref n ?a))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 ; (error "%s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 ; (format "fucked with %S: %x %x"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 ; spec (aref o ?a) (aref n ?a))))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263
3067
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
264 (defun describe-char-table (table mapper describe-value stream)
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
265 "Describe char-table TABLE, outputting to STREAM.
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
266 MAPPER maps over the table and should be `map-char-table' or
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
267 `map-syntax-table'. DESCRIBE-VALUE is a function of two arguments,
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
268 VALUE and STREAM, and should output a description of VALUE."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 (let (first-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 last-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 prev-val
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 (describe-one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 (if (featurep 'mule)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 #'(lambda (first last value stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 (if (equal first last)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 (cond ((vectorp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 (princ (format "%s, row %d\t"
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
278 (declare-fboundp (charset-name
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
279 (aref first 0)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 (aref first 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 ((symbolp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 (princ first stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 (princ "\t" stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 (princ (text-char-description first) stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (princ "\t" stream)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (cond ((vectorp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 (princ (format "%s, rows %d .. %d\t"
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
290 (declare-fboundp (charset-name
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
291 (aref first 0)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 (aref first 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 (aref last 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 ((symbolp first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 (princ (format "%s .. %s\t" first last) stream))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 (princ (format "%s .. %s\t"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 (text-char-description first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 (text-char-description last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 stream))))
3067
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
302 (funcall describe-value value stream))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 #'(lambda (first last value stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (let* ((tem (text-char-description first))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (pos (length tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 ;;(limit (cond ((numberp ctl-arrow) ctl-arrow)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 ;; ((memq ctl-arrow '(t nil)) 256)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 ;; (t 160)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (princ tem stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (if (> last first)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (princ " .. " stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (setq tem (text-char-description last))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (princ tem stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (setq pos (+ pos (length tem) 4))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (while (progn (write-char ?\ stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (setq pos (1+ pos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 (< pos 16))))
3067
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
320 (funcall describe-value value stream)))))
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
321 (funcall mapper
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 #'(lambda (range value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 ((not first-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 (setq first-char range
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 last-char range
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 prev-val value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ((and (equal value prev-val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 (or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (and (characterp range)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (characterp first-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (or (not (featurep 'mule))
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
333 (eq (declare-fboundp (char-charset range))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
334 (declare-fboundp (char-charset first-char))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (= (char-int last-char) (1- (char-int range))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (and (vectorp range)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 (vectorp first-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (eq (aref range 0) (aref first-char 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 (= (aref last-char 1) (1- (aref range 1))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 (setq last-char range))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (funcall describe-one first-char last-char prev-val stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (setq first-char range
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 last-char range
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 prev-val value)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (if first-char
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (funcall describe-one first-char last-char prev-val stream))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350
3067
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
351 (defun describe-syntax-table (table stream)
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
352 "Output a description of TABLE (a syntax table) to STREAM."
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
353 (describe-char-table table 'map-syntax-table 'describe-syntax-code stream))
2f31c7aa4e96 [xemacs-hg @ 2005-11-13 10:57:59 by ben]
ben
parents: 502
diff changeset
354
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 (defun describe-syntax-code (code stream)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (let ((match (and (consp code) (cdr code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (invalid (gettext "**invalid**")) ;(empty "") ;constants
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 (standard-output (or stream standard-output))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 ;; #### I18N3 should temporarily set buffer to output-translatable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (in #'(lambda (string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (princ ",\n\t\t\t\t ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 (princ string)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (syntax-string (syntax-code-to-string code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (if (consp code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 (setq code (car code)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (if (null syntax-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (princ invalid)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (princ syntax-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (princ "\tmeaning: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (princ (aref ["whitespace" "punctuation" "word-constituent"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 "symbol-constituent" "open-paren" "close-paren"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 "expression-prefix" "string-quote" "paired-delimiter"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 "escape" "character-quote" "comment-begin" "comment-end"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 "inherit" "extended-word-constituent"]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (logand code 127)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 (if match
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 (princ ", matches ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (princ (text-char-description match))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (let* ((spec (elt syntax-string 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (b3 (lsh code -16))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 (start1 (/= 0 (logand b3 128))) ;logtest!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 (start1b (/= 0 (logand b3 64)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (start2 (/= 0 (logand b3 32)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (start2b (/= 0 (logand b3 16)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (end1 (/= 0 (logand b3 8)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (end1b (/= 0 (logand b3 4)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 (end2 (/= 0 (logand b3 2)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 (end2b (/= 0 (logand b3 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (prefix (/= 0 (logand code 128)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (single-char-p (or (= spec ?<) (= spec ?>))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (if start1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (if single-char-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (princ ", style A")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (gettext "first character of comment-start sequence A"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (if start2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (gettext "second character of comment-start sequence A")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (if end1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (if single-char-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (princ ", style A")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (gettext "first character of comment-end sequence A"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (if end2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (gettext "second character of comment-end sequence A")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (if start1b
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 (if single-char-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (princ ", style B")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 (gettext "first character of comment-start sequence B"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 (if start2b
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 (gettext "second character of comment-start sequence B")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (if end1b
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (if single-char-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (princ ", style B")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (gettext "first character of comment-end sequence B"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (if end2b
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (gettext "second character of comment-end sequence B")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (if prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (funcall in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (gettext "prefix character for `backward-prefix-chars'"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (terpri stream))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (defun symbol-near-point ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 "Return the first textual item to the nearest point."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 ;alg stolen from etag.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (if (or (bobp) (not (memq (char-syntax (char-before)) '(?w ?_))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (while (not (looking-at "\\sw\\|\\s_\\|\\'"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (forward-char 1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (while (looking-at "\\sw\\|\\s_")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (forward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (if (re-search-backward "\\sw\\|\\s_" nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (regexp-quote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 (progn (forward-char 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (buffer-substring (point)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (progn (forward-sexp -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (while (looking-at "\\s'")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (forward-char 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (point)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 ;;; syntax.el ends here