Mercurial > emacs

comparison lisp/emacs-lisp/syntax.el @ 110305:b10051866f51

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New syntax-propertize functionality. * lisp/font-lock.el (font-lock-syntactic-keywords): Make obsolete. (font-lock-fontify-syntactic-keywords-region): Move handling of font-lock-syntactically-fontified to... (font-lock-default-fontify-region): ...here. Let syntax-propertize-function take precedence. (font-lock-fontify-syntactically-region): Cal syntax-propertize. * lisp/emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups. * lisp/emacs-lisp/syntax.el (syntax-propertize-function) (syntax-propertize-chunk-size, syntax-propertize--done) (syntax-propertize-extend-region-functions): New vars. (syntax-propertize-wholelines, syntax-propertize-multiline) (syntax-propertize--shift-groups, syntax-propertize-via-font-lock) (syntax-propertize): New functions. (syntax-propertize-rules): New macro. (syntax-ppss-flush-cache): Set syntax-propertize--done. (syntax-ppss): Call syntax-propertize. * lisp/progmodes/ada-mode.el (ada-set-syntax-table-properties) (ada-after-change-function, ada-initialize-syntax-table-properties) (ada-handle-syntax-table-properties): Only define when syntax-propertize is not available. (ada-mode): Use syntax-propertize-function. * lisp/progmodes/autoconf.el (autoconf-mode): Use syntax-propertize-function. (autoconf-font-lock-syntactic-keywords): Remove. * lisp/progmodes/cfengine.el (cfengine-mode): Use syntax-propertize-function. (cfengine-font-lock-syntactic-keywords): Remove. * lisp/progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function. * lisp/progmodes/fortran.el (fortran-mode): Use syntax-propertize-function. (fortran--font-lock-syntactic-keywords): New var. (fortran-line-length): Update syntax-propertize-function and fortran--font-lock-syntactic-keywords. * lisp/progmodes/gud.el (gdb-script-syntax-propertize-function): New var; replaces gdb-script-font-lock-syntactic-keywords. (gdb-script-mode): Use it. * lisp/progmodes/js.el (js--regexp-literal): Define while compiling. (js-syntax-propertize-function): New var; replaces js-font-lock-syntactic-keywords. (js-mode): Use it. * lisp/progmodes/make-mode.el (makefile-syntax-propertize-function): New var; replaces makefile-font-lock-syntactic-keywords. (makefile-mode): Use it. (makefile-imake-mode): Adjust. * lisp/progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var; replaces mixal-font-lock-syntactic-keywords. (mixal-mode): Use it. * lisp/progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function to replace octave-font-lock-close-quotes. (octave-syntax-propertize-function): New function to replace octave-font-lock-syntactic-keywords. (octave-mode): Use it. * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to replace perl-font-lock-syntactic-keywords. (perl-syntax-propertize-special-constructs): New fun to replace perl-font-lock-special-syntactic-constructs. (perl-font-lock-syntactic-face-function): New fun. (perl-mode): Use it. * lisp/progmodes/python.el (python-syntax-propertize-function): New var to replace python-font-lock-syntactic-keywords. (python-mode): Use it. (python-quote-syntax): Simplify and adjust to new use. * lisp/progmodes/ruby-mode.el (ruby-here-doc-beg-re): Define while compiling. (ruby-here-doc-end-re, ruby-here-doc-beg-match) (ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax) (syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p) (ruby-here-doc-find-end, ruby-here-doc-beg-syntax) (ruby-here-doc-end-syntax): Only define when syntax-propertize is not available. (ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc): New functions. (ruby-in-ppss-context-p): Update to new syntax of heredocs. (electric-indent-chars): Silence bytecompiler. (ruby-mode): Use prog-mode, syntax-propertize-function, and electric-indent-chars. * lisp/progmodes/sh-script.el (sh-st-symbol): Remove. (sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg. (sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove. (sh-font-lock-quoted-subshell): Assume we've already matched $(. (sh-font-lock-paren): Set syntax-multiline. (sh-font-lock-syntactic-keywords): Remove. (sh-syntax-propertize-function): New function to replace it. (sh-mode): Use it. * lisp/progmodes/simula.el (simula-syntax-propertize-function): New var to replace simula-font-lock-syntactic-keywords. (simula-mode): Use it. * lisp/progmodes/tcl.el (tcl-syntax-propertize-function): New var to replace tcl-font-lock-syntactic-keywords. (tcl-mode): Use it. * lisp/progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function if available. (vhdl-fontify-buffer): Adjust. * lisp/textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function. * lisp/textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare since we don't use it. * lisp/textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to replace sgml-font-lock-syntactic-keywords. (sgml-mode): Use it. * lisp/textmodes/tex-mode.el (tex-common-initialization, doctex-mode): Use syntax-propertize-function. * lisp/textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun to replace texinfo-font-lock-syntactic-keywords. (texinfo-mode): Use it. * test/indent/octave.m: Remove some `fixindent' not needed any more.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Sat, 11 Sep 2010 01:13:42 +0200
parents 98d8e4cd2326
children 14dab55b2888
comparison
equal deleted inserted replaced
110304:9e6d02d51b19 110305:b10051866f51
32 32
33 ;;; Todo: 33 ;;; Todo:
34 34
35 ;; - do something about the case where the syntax-table is changed. 35 ;; - do something about the case where the syntax-table is changed.
36 ;; This typically happens with tex-mode and its `$' operator. 36 ;; This typically happens with tex-mode and its `$' operator.
37 ;; - move font-lock-syntactic-keywords in here. Then again, maybe not.
38 ;; - new functions `syntax-state', ... to replace uses of parse-partial-state 37 ;; - new functions `syntax-state', ... to replace uses of parse-partial-state
39 ;; with something higher-level (similar to syntax-ppss-context). 38 ;; with something higher-level (similar to syntax-ppss-context).
40 ;; - interaction with mmm-mode. 39 ;; - interaction with mmm-mode.
41 40
42 ;;; Code: 41 ;;; Code:
44 ;; Note: PPSS stands for `parse-partial-sexp state' 43 ;; Note: PPSS stands for `parse-partial-sexp state'
45 44
46 (eval-when-compile (require 'cl)) 45 (eval-when-compile (require 'cl))
47 46
48 (defvar font-lock-beginning-of-syntax-function) 47 (defvar font-lock-beginning-of-syntax-function)
48
49 ;;; Applying syntax-table properties where needed.
50
51 (defvar syntax-propertize-function nil
52 ;; Rather than a -functions hook, this is a -function because it's easier
53 ;; to do a single scan than several scans: with multiple scans, one cannot
54 ;; assume that the text before point has been propertized, so syntax-ppss
55 ;; gives unreliable results (and stores them in its cache to boot, so we'd
56 ;; have to flush that cache between each function, and we couldn't use
57 ;; syntax-ppss-flush-cache since that would not only flush the cache but also
58 ;; reset syntax-propertize--done which should not be done in this case).
59 "Mode-specific function to apply the syntax-table properties.
60 Called with 2 arguments: START and END.")
61
62 (defvar syntax-propertize-chunk-size 500)
63
64 (defvar syntax-propertize-extend-region-functions
65 '(syntax-propertize-wholelines)
66 "Special hook run just before proceeding to propertize a region.
67 This is used to allow major modes to help `syntax-propertize' find safe buffer
68 positions as beginning and end of the propertized region. Its most common use
69 is to solve the problem of /identification/ of multiline elements by providing
70 a function that tries to find such elements and move the boundaries such that
71 they do not fall in the middle of one.
72 Each function is called with two arguments (START and END) and it should return
73 either a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
74 These functions are run in turn repeatedly until they all return nil.
75 Put first the functions more likely to cause a change and cheaper to compute.")
76 ;; Mark it as a special hook which doesn't use any global setting
77 ;; (i.e. doesn't obey the element t in the buffer-local value).
78 (make-variable-buffer-local 'syntax-propertize-extend-region-functions)
79
80 (defun syntax-propertize-wholelines (start end)
81 (goto-char start)
82 (cons (line-beginning-position)
83 (progn (goto-char end)
84 (if (bolp) (point) (line-beginning-position 2)))))
85
86 (defun syntax-propertize-multiline (beg end)
87 "Let `syntax-propertize' pay attention to the syntax-multiline property."
88 (when (and (> beg (point-min))
89 (get-text-property (1- beg) 'syntax-multiline))
90 (setq beg (or (previous-single-property-change beg 'syntax-multiline)
91 (point-min))))
92 ;;
93 (when (get-text-property end 'font-lock-multiline)
94 (setq end (or (text-property-any end (point-max)
95 'syntax-multiline nil)
96 (point-max))))
97 (cons beg end))
98
99 (defvar syntax-propertize--done -1
100 "Position upto which syntax-table properties have been set.")
101 (make-variable-buffer-local 'syntax-propertize--done)
102
103 (defun syntax-propertize--shift-groups (re n)
104 (replace-regexp-in-string
105 "\\\\(\\?\\([0-9]+\\):"
106 (lambda (s)
107 (replace-match
108 (number-to-string (+ n (string-to-number (match-string 1 s))))
109 t t s 1))
110 re t t))
111
112 (defmacro syntax-propertize-rules (&rest rules)
113 "Make a function that applies RULES for use in `syntax-propertize-function'.
114 The function will scan the buffer, applying the rules where they match.
115 The buffer is scanned a single time, like \"lex\" would, rather than once
116 per rule.
117
118 Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP
119 is an expression (evaluated at time of macro-expansion) that returns a regexp,
120 and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to
121 apply the property SYNTAX to the chars matched by the subgroup NUMBER
122 of the regular expression, if NUMBER did match.
123 SYNTAX is an expression that returns a value to apply as `syntax-table'
124 property. Some expressions are handled specially:
125 - if SYNTAX is a string, then it is converted with `string-to-syntax';
126 - if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP
127 will be applied to the buffer before running EXPS and if EXP is a string it
128 is also converted with `string-to-syntax'.
129 The SYNTAX expression is responsible to save the `match-data' if needed
130 for subsequent HIGHLIGHTs.
131 Also SYNTAX is free to move point, in which case RULES may not be applied to
132 some parts of the text or may be applied several times to other parts.
133
134 Note: back-references in REGEXPs do not work."
135 (declare (debug (&rest (form &rest
136 (numberp
137 [&or stringp
138 ("prog1" [&or stringp def-form] def-body)
139 def-form])))))
140 (let* ((offset 0)
141 (branches '())
142 ;; We'd like to use a real DFA-based lexer, usually, but since Emacs
143 ;; doesn't have one yet, we fallback on building one large regexp
144 ;; and use groups to determine which branch of the regexp matched.
145 (re
146 (mapconcat
147 (lambda (rule)
148 (let ((re (eval (car rule))))
149 (when (and (assq 0 rule) (cdr rules))
150 ;; If there's more than 1 rule, and the rule want to apply
151 ;; highlight to match 0, create an extra group to be able to
152 ;; tell when *this* match 0 has succeeded.
153 (incf offset)
154 (setq re (concat "\\(" re "\\)")))
155 (setq re (syntax-propertize--shift-groups re offset))
156 (let ((code '())
157 (condition
158 (cond
159 ((assq 0 rule) (if (zerop offset) t
160 `(match-beginning ,offset)))
161 ((null (cddr rule))
162 `(match-beginning ,(+ offset (car (cadr rule)))))
163 (t
164 `(or ,@(mapcar
165 (lambda (case)
166 `(match-beginning ,(+ offset (car case))))
167 (cdr rule))))))
168 (nocode t)
169 (offset offset))
170 ;; If some of the subgroup rules include Elisp code, then we
171 ;; need to set the match-data so it's consistent with what the
172 ;; code expects. If not, then we can simply use shifted
173 ;; offset in our own code.
174 (unless (zerop offset)
175 (dolist (case (cdr rule))
176 (unless (stringp (cadr case))
177 (setq nocode nil)))
178 (unless nocode
179 (push `(let ((md (match-data 'ints)))
180 ;; Keep match 0 as is, but shift everything else.
181 (setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md))
182 (set-match-data md))
183 code)
184 (setq offset 0)))
185 ;; Now construct the code for each subgroup rules.
186 (dolist (case (cdr rule))
187 (assert (null (cddr case)))
188 (let* ((gn (+ offset (car case)))
189 (action (nth 1 case))
190 (thiscode
191 (cond
192 ((stringp action)
193 `((put-text-property
194 (match-beginning ,gn) (match-end ,gn)
195 'syntax-table
196 ',(string-to-syntax action))))
197 ((eq (car-safe action) 'ignore)
198 (cdr action))
199 ((eq (car-safe action) 'prog1)
200 (if (stringp (nth 1 action))
201 `((put-text-property
202 (match-beginning ,gn) (match-end ,gn)
203 'syntax-table
204 ',(string-to-syntax (nth 1 action)))
205 ,@(nthcdr 2 action))
206 `((let ((mb (match-beginning ,gn))
207 (me (match-end ,gn))
208 (syntax ,(nth 1 action)))
209 (if syntax
210 (put-text-property
211 mb me 'syntax-table syntax))
212 ,@(nthcdr 2 action)))))
213 (t
214 `((let ((mb (match-beginning ,gn))
215 (me (match-end ,gn))
216 (syntax ,action))
217 (if syntax
218 (put-text-property
219 mb me 'syntax-table syntax))))))))
220
221 (if (or (not (cddr rule)) (zerop gn))
222 (setq code (nconc (nreverse thiscode) code))
223 (push `(if (match-beginning ,gn)
224 ;; Try and generate clean code with no
225 ;; extraneous progn.
226 ,(if (null (cdr thiscode))
227 (car thiscode)
228 `(progn ,@thiscode)))
229 code))))
230 (push (cons condition (nreverse code))
231 branches))
232 (incf offset (regexp-opt-depth re))
233 re))
234 rules
235 "\\|")))
236 `(lambda (start end)
237 (goto-char start)
238 (while (and (< (point) end)
239 (re-search-forward ,re end t))
240 (cond ,@(nreverse branches))))))
241
242 (defun syntax-propertize-via-font-lock (keywords)
243 "Propertize for syntax in START..END using font-lock syntax.
244 KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
245 The return value is a function suitable for `syntax-propertize-function'."
246 (lexical-let ((keywords keywords))
247 (lambda (start end)
248 (with-no-warnings
249 (let ((font-lock-syntactic-keywords keywords))
250 (font-lock-fontify-syntactic-keywords-region start end)
251 ;; In case it was eval'd/compiled.
252 (setq keywords font-lock-syntactic-keywords))))))
253
254 (defun syntax-propertize (pos)
255 "Ensure that syntax-table properties are set upto POS."
256 (when (and syntax-propertize-function
257 (< syntax-propertize--done pos))
258 ;; (message "Needs to syntax-propertize from %s to %s"
259 ;; syntax-propertize--done pos)
260 (set (make-local-variable 'parse-sexp-lookup-properties) t)
261 (save-excursion
262 (with-silent-modifications
263 (let* ((start (max syntax-propertize--done (point-min)))
264 (end (max pos
265 (min (point-max)
266 (+ start syntax-propertize-chunk-size))))
267 (funs syntax-propertize-extend-region-functions))
268 (while funs
269 (let ((new (funcall (pop funs) start end)))
270 (if (or (null new)
271 (and (>= (car new) start) (<= (cdr new) end)))
272 nil
273 (setq start (car new))
274 (setq end (cdr new))
275 ;; If there's been a change, we should go through the
276 ;; list again since this new position may
277 ;; warrant a different answer from one of the funs we've
278 ;; already seen.
279 (unless (eq funs
280 (cdr syntax-propertize-extend-region-functions))
281 (setq funs syntax-propertize-extend-region-functions)))))
282 ;; Move the limit before calling the function, so the function
283 ;; can use syntax-ppss.
284 (setq syntax-propertize--done end)
285 ;; (message "syntax-propertizing from %s to %s" start end)
286 (remove-text-properties start end
287 '(syntax-table nil syntax-multiline nil))
288 (funcall syntax-propertize-function start end))))))
289
290 ;;; Incrementally compute and memoize parser state.
49 291
50 (defsubst syntax-ppss-depth (ppss) 292 (defsubst syntax-ppss-depth (ppss)
51 (nth 0 ppss)) 293 (nth 0 ppss))
52 294
53 (defun syntax-ppss-toplevel-pos (ppss) 295 (defun syntax-ppss-toplevel-pos (ppss)
90 (make-variable-buffer-local 'syntax-ppss-last) 332 (make-variable-buffer-local 'syntax-ppss-last)
91 333
92 (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) 334 (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
93 (defun syntax-ppss-flush-cache (beg &rest ignored) 335 (defun syntax-ppss-flush-cache (beg &rest ignored)
94 "Flush the cache of `syntax-ppss' starting at position BEG." 336 "Flush the cache of `syntax-ppss' starting at position BEG."
337 ;; Set syntax-propertize to refontify anything past beg.
338 (setq syntax-propertize--done (min beg syntax-propertize--done))
95 ;; Flush invalid cache entries. 339 ;; Flush invalid cache entries.
96 (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) 340 (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))
97 (setq syntax-ppss-cache (cdr syntax-ppss-cache))) 341 (setq syntax-ppss-cache (cdr syntax-ppss-cache)))
98 ;; Throw away `last' value if made invalid. 342 ;; Throw away `last' value if made invalid.
99 (when (< beg (or (car syntax-ppss-last) 0)) 343 (when (< beg (or (car syntax-ppss-last) 0))
126 The returned value is the same as `parse-partial-sexp' except that 370 The returned value is the same as `parse-partial-sexp' except that
127 the 2nd and 6th values of the returned state cannot be relied upon. 371 the 2nd and 6th values of the returned state cannot be relied upon.
128 Point is at POS when this function returns." 372 Point is at POS when this function returns."
129 ;; Default values. 373 ;; Default values.
130 (unless pos (setq pos (point))) 374 (unless pos (setq pos (point)))
375 (syntax-propertize pos)
131 ;; 376 ;;
132 (let ((old-ppss (cdr syntax-ppss-last)) 377 (let ((old-ppss (cdr syntax-ppss-last))
133 (old-pos (car syntax-ppss-last)) 378 (old-pos (car syntax-ppss-last))
134 (ppss nil) 379 (ppss nil)
135 (pt-min (point-min))) 380 (pt-min (point-min)))