Mercurial > emacs
comparison lisp/font-lock.el @ 13440:e8cd2c9309c8
1. Use local hooks, not local variables.
2. Wrap font-lock-fontify-region, not called fns.
3. Guarantee anchored keywords don't span lines.
author | Simon Marshall <simon@gnu.org> |
---|---|
date | Thu, 09 Nov 1995 08:26:32 +0000 |
parents | 84acc3adcd63 |
children | 5aab5c1f2c33 |
comparison
equal
deleted
inserted
replaced
13439:c38b7ee76ecc | 13440:e8cd2c9309c8 |
---|---|
1 ;;; font-lock.el --- electric font lock mode | 1 ;;; font-lock.el --- Electric font lock mode |
2 | |
2 ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. |
3 | 4 |
4 ;; Author: jwz, then rms, then sm <simon@gnu.ai.mit.edu> | 5 ;; Author: jwz, then rms, then sm <simon@gnu.ai.mit.edu> |
5 ;; Maintainer: FSF | 6 ;; Maintainer: FSF |
6 ;; Keywords: languages, faces | 7 ;; Keywords: languages, faces |
164 which the new or existing fontification, respectively, takes precedence. | 165 which the new or existing fontification, respectively, takes precedence. |
165 If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER. | 166 If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER. |
166 | 167 |
167 For example, an element of the form highlights (if not already highlighted): | 168 For example, an element of the form highlights (if not already highlighted): |
168 | 169 |
169 \"foo\" Occurrences of \"foo\" in `font-lock-keyword-face'. | 170 \"\\\\\\=<foo\\\\\\=>\" Discrete occurrences of \"foo\" in the value of the |
171 variable `font-lock-keyword-face'. | |
170 (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in | 172 (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in |
171 the value of `font-lock-keyword-face'. | 173 the value of `font-lock-keyword-face'. |
172 (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'. | 174 (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'. |
173 (\"foo\\\\|bar\" 0 foo-bar-face t) | 175 (\"foo\\\\|bar\" 0 foo-bar-face t) |
174 Occurrences of either \"foo\" or \"bar\" in the value | 176 Occurrences of either \"foo\" or \"bar\" in the value |
176 | 178 |
177 MATCH-ANCHORED should be of the form: | 179 MATCH-ANCHORED should be of the form: |
178 | 180 |
179 (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) | 181 (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) |
180 | 182 |
181 Where MATCHER is as for MATCH-HIGHLIGHT. PRE-MATCH-FORM and POST-MATCH-FORM | 183 Where MATCHER is as for MATCH-HIGHLIGHT with one exception. The limit of the |
182 are evaluated before the first, and after the last, instance MATCH-ANCHORED's | 184 search is currently guaranteed to be (no greater than) the end of the line. |
183 MATCHER is used. Therefore they can be used to initialise before, and cleanup | 185 PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after |
184 after, MATCHER is used. Typically, PRE-MATCH-FORM is used to move to some | 186 the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be |
185 position relative to the original MATCHER, before starting with | 187 used to initialise before, and cleanup after, MATCHER is used. Typically, |
186 MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might be used to move, before | 188 PRE-MATCH-FORM is used to move to some position relative to the original |
187 resuming with MATCH-ANCHORED's parent's MATCHER. | 189 MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might |
190 be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER. | |
188 | 191 |
189 For example, an element of the form highlights (if not already highlighted): | 192 For example, an element of the form highlights (if not already highlighted): |
190 | 193 |
191 (\"anchor\" (0 anchor-face) (\".*\\\\(item\\\\)\" nil nil (1 item-face))) | 194 (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face))) |
192 | 195 |
193 Occurrences of \"anchor\" in the value of `anchor-face', and subsequent | 196 Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent |
194 occurrences of \"item\" on the same line (by virtue of the `.*' regexp) in the | 197 discrete occurrences of \"item\" (on the same line) in the value of `item-face'. |
195 value of `item-face'. (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. | 198 (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is |
196 Therefore \"item\" is initially searched for starting from the end of the match | 199 initially searched for starting from the end of the match of \"anchor\", and |
197 of \"anchor\", and searching for subsequent instance of \"anchor\" resumes from | 200 searching for subsequent instance of \"anchor\" resumes from where searching |
198 where searching for \"item\" concluded.) | 201 for \"item\" concluded.) |
199 | 202 |
200 Note that the MATCH-ANCHORED feature is experimental; in the future, we may | 203 Note that the MATCH-ANCHORED feature is experimental; in the future, we may |
201 replace it with other ways of providing this functionality. | 204 replace it with other ways of providing this functionality. |
202 | 205 |
203 These regular expressions should not match text which spans lines. While | 206 These regular expressions should not match text which spans lines. While |
320 | 323 |
321 ;; User functions. | 324 ;; User functions. |
322 | 325 |
323 ;;;###autoload | 326 ;;;###autoload |
324 (defun font-lock-mode (&optional arg) | 327 (defun font-lock-mode (&optional arg) |
325 "Toggle Font Lock mode. | 328 "[pretest] Toggle Font Lock mode. |
326 With arg, turn Font Lock mode on if and only if arg is positive. | 329 With arg, turn Font Lock mode on if and only if arg is positive. |
327 | 330 |
328 When Font Lock mode is enabled, text is fontified as you type it: | 331 When Font Lock mode is enabled, text is fontified as you type it: |
329 | 332 |
330 - Comments are displayed in `font-lock-comment-face'; | 333 - Comments are displayed in `font-lock-comment-face'; |
360 (cdr (or (assq major-mode font-lock-maximum-size) | 363 (cdr (or (assq major-mode font-lock-maximum-size) |
361 (assq t font-lock-maximum-size)))))) | 364 (assq t font-lock-maximum-size)))))) |
362 (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... | 365 (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... |
363 (setq on-p nil)) | 366 (setq on-p nil)) |
364 (if (not on-p) | 367 (if (not on-p) |
365 (remove-hook 'after-change-functions 'font-lock-after-change-function) | 368 (remove-hook 'after-change-functions 'font-lock-after-change-function |
366 (make-local-variable 'after-change-functions) | 369 t) |
367 (add-hook 'after-change-functions 'font-lock-after-change-function)) | 370 (make-local-hook 'after-change-functions) |
371 (add-hook 'after-change-functions 'font-lock-after-change-function | |
372 nil t)) | |
368 (set (make-local-variable 'font-lock-mode) on-p) | 373 (set (make-local-variable 'font-lock-mode) on-p) |
369 (cond (on-p | 374 (cond (on-p |
370 (font-lock-set-defaults) | 375 (font-lock-set-defaults) |
371 (make-local-variable 'before-revert-hook) | 376 (make-local-hook 'before-revert-hook) |
372 (make-local-variable 'after-revert-hook) | 377 (make-local-hook 'after-revert-hook) |
373 ;; If buffer is reverted, must clean up the state. | 378 ;; If buffer is reverted, must clean up the state. |
374 (add-hook 'before-revert-hook 'font-lock-revert-setup) | 379 (add-hook 'before-revert-hook 'font-lock-revert-setup nil t) |
375 (add-hook 'after-revert-hook 'font-lock-revert-cleanup) | 380 (add-hook 'after-revert-hook 'font-lock-revert-cleanup nil t) |
376 (run-hooks 'font-lock-mode-hook) | 381 (run-hooks 'font-lock-mode-hook) |
377 (cond (font-lock-fontified | 382 (cond (font-lock-fontified |
378 nil) | 383 nil) |
379 ((or (null maximum-size) (<= (buffer-size) maximum-size)) | 384 ((or (null maximum-size) (<= (buffer-size) maximum-size)) |
380 (font-lock-fontify-buffer)) | 385 (font-lock-fontify-buffer)) |
381 (font-lock-verbose | 386 (font-lock-verbose |
382 (message "Fontifying %s... buffer too big." (buffer-name))))) | 387 (message "Fontifying %s... buffer too big." (buffer-name))))) |
383 (font-lock-fontified | 388 (font-lock-fontified |
384 (setq font-lock-fontified nil) | 389 (setq font-lock-fontified nil) |
385 (remove-hook 'before-revert-hook 'font-lock-revert-setup) | 390 (remove-hook 'before-revert-hook 'font-lock-revert-setup t) |
386 (remove-hook 'after-revert-hook 'font-lock-revert-cleanup) | 391 (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) |
387 (font-lock-unfontify-region (point-min) (point-max)) | 392 (font-lock-unfontify-region (point-min) (point-max)) |
388 (font-lock-thing-lock-cleanup)) | 393 (font-lock-thing-lock-cleanup)) |
389 (t | 394 (t |
390 (remove-hook 'before-revert-hook 'font-lock-revert-setup) | 395 (remove-hook 'before-revert-hook 'font-lock-revert-setup t) |
391 (remove-hook 'after-revert-hook 'font-lock-revert-cleanup) | 396 (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) |
392 (font-lock-thing-lock-cleanup))) | 397 (font-lock-thing-lock-cleanup))) |
393 (force-mode-line-update))) | 398 (force-mode-line-update))) |
394 | 399 |
395 ;;;###autoload | 400 ;;;###autoload |
396 (defun turn-on-font-lock () | 401 (defun turn-on-font-lock () |
400 ;;;###autoload | 405 ;;;###autoload |
401 (defun font-lock-fontify-buffer () | 406 (defun font-lock-fontify-buffer () |
402 "Fontify the current buffer the way `font-lock-mode' would." | 407 "Fontify the current buffer the way `font-lock-mode' would." |
403 (interactive) | 408 (interactive) |
404 (let ((verbose (and (or font-lock-verbose (interactive-p)) | 409 (let ((verbose (and (or font-lock-verbose (interactive-p)) |
405 (not (zerop (buffer-size))))) | 410 (not (zerop (buffer-size)))))) |
406 (modified (buffer-modified-p))) | |
407 (set (make-local-variable 'font-lock-fontified) nil) | 411 (set (make-local-variable 'font-lock-fontified) nil) |
408 (if verbose (message "Fontifying %s..." (buffer-name))) | 412 (if verbose (message "Fontifying %s..." (buffer-name))) |
409 ;; Turn it on to run hooks and get the right `font-lock-keywords' etc. | 413 ;; Turn it on to run hooks and get the right `font-lock-keywords' etc. |
410 (or font-lock-mode (font-lock-set-defaults)) | 414 (or font-lock-mode (font-lock-set-defaults)) |
411 (condition-case nil | 415 (condition-case nil |
412 (save-excursion | 416 (save-excursion |
413 (font-lock-fontify-region (point-min) (point-max) verbose) | 417 (save-match-data |
414 (setq font-lock-fontified t)) | 418 (font-lock-fontify-region (point-min) (point-max) verbose) |
419 (setq font-lock-fontified t))) | |
415 ;; We don't restore the old fontification, so it's best to unfontify. | 420 ;; We don't restore the old fontification, so it's best to unfontify. |
416 (quit (font-lock-unfontify-region (point-min) (point-max)))) | 421 (quit (font-lock-unfontify-region (point-min) (point-max)))) |
417 (if verbose (message "Fontifying %s... %s." (buffer-name) | 422 (if verbose (message "Fontifying %s... %s." (buffer-name) |
418 (if font-lock-fontified "done" "aborted"))) | 423 (if font-lock-fontified "done" "aborted"))) |
419 (and (buffer-modified-p) | |
420 (not modified) | |
421 (set-buffer-modified-p nil)) | |
422 (font-lock-after-fontify-buffer))) | 424 (font-lock-after-fontify-buffer))) |
423 | 425 |
424 ;; Fontification functions. | 426 ;; Fontification functions. |
425 | 427 |
426 ;; We use this wrapper. However, `font-lock-fontify-region' used to be the | 428 ;; We use this wrapper. However, `font-lock-fontify-region' used to be the |
427 ;; name used for `font-lock-fontify-syntactically-region', so a change isn't | 429 ;; name used for `font-lock-fontify-syntactically-region', so a change isn't |
428 ;; back-compatible. But you shouldn't be calling these directly, should you? | 430 ;; back-compatible. But you shouldn't be calling these directly, should you? |
429 (defun font-lock-fontify-region (beg end &optional loudly) | 431 (defun font-lock-fontify-region (beg end &optional loudly) |
430 (if font-lock-keywords-only | 432 (let ((modified (buffer-modified-p)) |
431 (font-lock-unfontify-region beg end) | 433 (buffer-undo-list t) (inhibit-read-only t) |
432 (font-lock-fontify-syntactically-region beg end loudly)) | 434 (old-syntax-table (syntax-table)) |
433 (font-lock-fontify-keywords-region beg end loudly)) | 435 buffer-file-name buffer-file-truename) |
436 (unwind-protect | |
437 (progn | |
438 ;; Use the fontification syntax table, if any. | |
439 (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) | |
440 ;; Now do the fontification. | |
441 (if font-lock-keywords-only | |
442 (font-lock-unfontify-region beg end) | |
443 (font-lock-fontify-syntactically-region beg end loudly)) | |
444 (font-lock-fontify-keywords-region beg end loudly)) | |
445 ;; Clean up. | |
446 (set-syntax-table old-syntax-table) | |
447 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) | |
434 | 448 |
435 ;; The following must be rethought, since keywords can override fontification. | 449 ;; The following must be rethought, since keywords can override fontification. |
436 ; ;; Now scan for keywords, but not if we are inside a comment now. | 450 ; ;; Now scan for keywords, but not if we are inside a comment now. |
437 ; (or (and (not font-lock-keywords-only) | 451 ; (or (and (not font-lock-keywords-only) |
438 ; (let ((state (parse-partial-sexp beg end nil nil | 452 ; (let ((state (parse-partial-sexp beg end nil nil |
443 (defun font-lock-unfontify-region (beg end) | 457 (defun font-lock-unfontify-region (beg end) |
444 (let ((modified (buffer-modified-p)) | 458 (let ((modified (buffer-modified-p)) |
445 (buffer-undo-list t) (inhibit-read-only t) | 459 (buffer-undo-list t) (inhibit-read-only t) |
446 buffer-file-name buffer-file-truename) | 460 buffer-file-name buffer-file-truename) |
447 (remove-text-properties beg end '(face nil)) | 461 (remove-text-properties beg end '(face nil)) |
448 (and (buffer-modified-p) | 462 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))) |
449 (not modified) | |
450 (set-buffer-modified-p nil)))) | |
451 | 463 |
452 ;; Called when any modification is made to buffer text. | 464 ;; Called when any modification is made to buffer text. |
453 (defun font-lock-after-change-function (beg end old-len) | 465 (defun font-lock-after-change-function (beg end old-len) |
454 (save-excursion | 466 (save-excursion |
455 (save-match-data | 467 (save-match-data |
461 ;; Syntactic fontification functions. | 473 ;; Syntactic fontification functions. |
462 | 474 |
463 (defun font-lock-fontify-syntactically-region (start end &optional loudly) | 475 (defun font-lock-fontify-syntactically-region (start end &optional loudly) |
464 "Put proper face on each string and comment between START and END. | 476 "Put proper face on each string and comment between START and END. |
465 START should be at the beginning of a line." | 477 START should be at the beginning of a line." |
466 (let ((inhibit-read-only t) (buffer-undo-list t) | 478 (let ((synstart (if comment-start-skip |
467 (modified (buffer-modified-p)) | |
468 (old-syntax (syntax-table)) | |
469 (synstart (if comment-start-skip | |
470 (concat "\\s\"\\|" comment-start-skip) | 479 (concat "\\s\"\\|" comment-start-skip) |
471 "\\s\"")) | 480 "\\s\"")) |
472 (comstart (if comment-start-skip | 481 (comstart (if comment-start-skip |
473 (concat "\\s<\\|" comment-start-skip) | 482 (concat "\\s<\\|" comment-start-skip) |
474 "\\s<")) | 483 "\\s<")) |
475 buffer-file-name buffer-file-truename | |
476 state prev prevstate) | 484 state prev prevstate) |
477 (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) | 485 (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) |
478 (unwind-protect | 486 (save-restriction |
479 (save-restriction | 487 (widen) |
480 (widen) | 488 (goto-char start) |
481 (goto-char start) | 489 ;; |
490 ;; Find the state at the `beginning-of-line' before `start'. | |
491 (if (eq start font-lock-cache-position) | |
492 ;; Use the cache for the state of `start'. | |
493 (setq state font-lock-cache-state) | |
494 ;; Find the state of `start'. | |
495 (if (null font-lock-beginning-of-syntax-function) | |
496 ;; Use the state at the previous cache position, if any, or | |
497 ;; otherwise calculate from `point-min'. | |
498 (if (or (null font-lock-cache-position) | |
499 (< start font-lock-cache-position)) | |
500 (setq state (parse-partial-sexp (point-min) start)) | |
501 (setq state (parse-partial-sexp font-lock-cache-position start | |
502 nil nil font-lock-cache-state))) | |
503 ;; Call the function to move outside any syntactic block. | |
504 (funcall font-lock-beginning-of-syntax-function) | |
505 (setq state (parse-partial-sexp (point) start))) | |
506 ;; Cache the state and position of `start'. | |
507 (setq font-lock-cache-state state | |
508 font-lock-cache-position start)) | |
509 ;; | |
510 ;; If the region starts inside a string, show the extent of it. | |
511 (if (nth 3 state) | |
512 (let ((beg (point))) | |
513 (while (and (re-search-forward "\\s\"" end 'move) | |
514 (nth 3 (parse-partial-sexp beg (point) | |
515 nil nil state)))) | |
516 (put-text-property beg (point) 'face font-lock-string-face) | |
517 (setq state (parse-partial-sexp beg (point) nil nil state)))) | |
518 ;; | |
519 ;; Likewise for a comment. | |
520 (if (or (nth 4 state) (nth 7 state)) | |
521 (let ((beg (point))) | |
522 (save-restriction | |
523 (narrow-to-region (point-min) end) | |
524 (condition-case nil | |
525 (progn | |
526 (re-search-backward comstart (point-min) 'move) | |
527 (forward-comment 1) | |
528 ;; forward-comment skips all whitespace, | |
529 ;; so go back to the real end of the comment. | |
530 (skip-chars-backward " \t")) | |
531 (error (goto-char end)))) | |
532 (put-text-property beg (point) 'face font-lock-comment-face) | |
533 (setq state (parse-partial-sexp beg (point) nil nil state)))) | |
534 ;; | |
535 ;; Find each interesting place between here and `end'. | |
536 (while (and (< (point) end) | |
537 (setq prev (point) prevstate state) | |
538 (re-search-forward synstart end t) | |
539 (progn | |
540 ;; Clear out the fonts of what we skip over. | |
541 (remove-text-properties prev (point) '(face nil)) | |
542 ;; Verify the state at that place | |
543 ;; so we don't get fooled by \" or \;. | |
544 (setq state (parse-partial-sexp prev (point) | |
545 nil nil state)))) | |
546 (let ((here (point))) | |
547 (if (or (nth 4 state) (nth 7 state)) | |
548 ;; | |
549 ;; We found a real comment start. | |
550 (let ((beg (match-beginning 0))) | |
551 (goto-char beg) | |
552 (save-restriction | |
553 (narrow-to-region (point-min) end) | |
554 (condition-case nil | |
555 (progn | |
556 (forward-comment 1) | |
557 ;; forward-comment skips all whitespace, | |
558 ;; so go back to the real end of the comment. | |
559 (skip-chars-backward " \t")) | |
560 (error (goto-char end)))) | |
561 (put-text-property beg (point) 'face | |
562 font-lock-comment-face) | |
563 (setq state (parse-partial-sexp here (point) nil nil state))) | |
564 (if (nth 3 state) | |
565 ;; | |
566 ;; We found a real string start. | |
567 (let ((beg (match-beginning 0))) | |
568 (while (and (re-search-forward "\\s\"" end 'move) | |
569 (nth 3 (parse-partial-sexp here (point) | |
570 nil nil state)))) | |
571 (put-text-property beg (point) 'face font-lock-string-face) | |
572 (setq state (parse-partial-sexp here (point) | |
573 nil nil state)))))) | |
482 ;; | 574 ;; |
483 ;; Use the fontification syntax table, if any. | 575 ;; Make sure `prev' is non-nil after the loop |
484 (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) | 576 ;; only if it was set on the very last iteration. |
485 ;; | 577 (setq prev nil))) |
486 ;; Find the state at the `beginning-of-line' before `start'. | 578 ;; |
487 (if (eq start font-lock-cache-position) | 579 ;; Clean up. |
488 ;; Use the cache for the state of `start'. | 580 (and prev (remove-text-properties prev end '(face nil))))) |
489 (setq state font-lock-cache-state) | |
490 ;; Find the state of `start'. | |
491 (if (null font-lock-beginning-of-syntax-function) | |
492 ;; Use the state at the previous cache position, if any, or | |
493 ;; otherwise calculate from `point-min'. | |
494 (if (or (null font-lock-cache-position) | |
495 (< start font-lock-cache-position)) | |
496 (setq state (parse-partial-sexp (point-min) start)) | |
497 (setq state (parse-partial-sexp | |
498 font-lock-cache-position start | |
499 nil nil font-lock-cache-state))) | |
500 ;; Call the function to move outside any syntactic block. | |
501 (funcall font-lock-beginning-of-syntax-function) | |
502 (setq state (parse-partial-sexp (point) start))) | |
503 ;; Cache the state and position of `start'. | |
504 (setq font-lock-cache-state state | |
505 font-lock-cache-position start)) | |
506 ;; | |
507 ;; If the region starts inside a string, show the extent of it. | |
508 (if (nth 3 state) | |
509 (let ((beg (point))) | |
510 (while (and (re-search-forward "\\s\"" end 'move) | |
511 (nth 3 (parse-partial-sexp beg (point) | |
512 nil nil state)))) | |
513 (put-text-property beg (point) 'face font-lock-string-face) | |
514 (setq state (parse-partial-sexp beg (point) nil nil state)))) | |
515 ;; | |
516 ;; Likewise for a comment. | |
517 (if (or (nth 4 state) (nth 7 state)) | |
518 (let ((beg (point))) | |
519 (save-restriction | |
520 (narrow-to-region (point-min) end) | |
521 (condition-case nil | |
522 (progn | |
523 (re-search-backward comstart (point-min) 'move) | |
524 (forward-comment 1) | |
525 ;; forward-comment skips all whitespace, | |
526 ;; so go back to the real end of the comment. | |
527 (skip-chars-backward " \t")) | |
528 (error (goto-char end)))) | |
529 (put-text-property beg (point) 'face font-lock-comment-face) | |
530 (setq state (parse-partial-sexp beg (point) nil nil state)))) | |
531 ;; | |
532 ;; Find each interesting place between here and `end'. | |
533 (while (and (< (point) end) | |
534 (setq prev (point) prevstate state) | |
535 (re-search-forward synstart end t) | |
536 (progn | |
537 ;; Clear out the fonts of what we skip over. | |
538 (remove-text-properties prev (point) '(face nil)) | |
539 ;; Verify the state at that place | |
540 ;; so we don't get fooled by \" or \;. | |
541 (setq state (parse-partial-sexp prev (point) | |
542 nil nil state)))) | |
543 (let ((here (point))) | |
544 (if (or (nth 4 state) (nth 7 state)) | |
545 ;; | |
546 ;; We found a real comment start. | |
547 (let ((beg (match-beginning 0))) | |
548 (goto-char beg) | |
549 (save-restriction | |
550 (narrow-to-region (point-min) end) | |
551 (condition-case nil | |
552 (progn | |
553 (forward-comment 1) | |
554 ;; forward-comment skips all whitespace, | |
555 ;; so go back to the real end of the comment. | |
556 (skip-chars-backward " \t")) | |
557 (error (goto-char end)))) | |
558 (put-text-property beg (point) 'face | |
559 font-lock-comment-face) | |
560 (setq state (parse-partial-sexp here (point) nil nil state))) | |
561 (if (nth 3 state) | |
562 ;; | |
563 ;; We found a real string start. | |
564 (let ((beg (match-beginning 0))) | |
565 (while (and (re-search-forward "\\s\"" end 'move) | |
566 (nth 3 (parse-partial-sexp here (point) | |
567 nil nil state)))) | |
568 (put-text-property beg (point) 'face font-lock-string-face) | |
569 (setq state (parse-partial-sexp here (point) | |
570 nil nil state)))))) | |
571 ;; | |
572 ;; Make sure `prev' is non-nil after the loop | |
573 ;; only if it was set on the very last iteration. | |
574 (setq prev nil))) | |
575 ;; | |
576 ;; Clean up. | |
577 (set-syntax-table old-syntax) | |
578 (if prev (remove-text-properties prev end '(face nil))) | |
579 (and (buffer-modified-p) | |
580 (not modified) | |
581 (set-buffer-modified-p nil))))) | |
582 | 581 |
583 ;;; Additional text property functions. | 582 ;;; Additional text property functions. |
584 | 583 |
585 ;; The following three text property functions are not generally available (and | 584 ;; The following three text property functions are not generally available (and |
586 ;; it's not certain that they should be) so they are inlined for speed. | 585 ;; it's not certain that they should be) so they are inlined for speed. |
690 | 689 |
691 (defsubst font-lock-fontify-anchored-keywords (keywords limit) | 690 (defsubst font-lock-fontify-anchored-keywords (keywords limit) |
692 "Fontify according to KEYWORDS until LIMIT. | 691 "Fontify according to KEYWORDS until LIMIT. |
693 KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords'." | 692 KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords'." |
694 (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights) | 693 (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights) |
694 ;; Until we come up with a cleaner solution, we make LIMIT the end of line. | |
695 (save-excursion (end-of-line) (setq limit (min limit (point)))) | |
696 ;; Evaluate PRE-MATCH-FORM. | |
695 (eval (nth 1 keywords)) | 697 (eval (nth 1 keywords)) |
696 (save-match-data | 698 (save-match-data |
699 ;; Find an occurrence of `matcher' before `limit'. | |
697 (while (if (stringp matcher) | 700 (while (if (stringp matcher) |
698 (re-search-forward matcher limit t) | 701 (re-search-forward matcher limit t) |
699 (funcall matcher limit)) | 702 (funcall matcher limit)) |
703 ;; Apply each highlight to this instance of `matcher'. | |
700 (setq highlights lowdarks) | 704 (setq highlights lowdarks) |
701 (while highlights | 705 (while highlights |
702 (font-lock-apply-highlight (car highlights)) | 706 (font-lock-apply-highlight (car highlights)) |
703 (setq highlights (cdr highlights))))) | 707 (setq highlights (cdr highlights))))) |
708 ;; Evaluate POST-MATCH-FORM. | |
704 (eval (nth 2 keywords)))) | 709 (eval (nth 2 keywords)))) |
705 | 710 |
706 (defun font-lock-fontify-keywords-region (start end &optional loudly) | 711 (defun font-lock-fontify-keywords-region (start end &optional loudly) |
707 "Fontify according to `font-lock-keywords' between START and END. | 712 "Fontify according to `font-lock-keywords' between START and END. |
708 START should be at the beginning of a line." | 713 START should be at the beginning of a line." |
709 (let ((case-fold-search font-lock-keywords-case-fold-search) | 714 (let ((case-fold-search font-lock-keywords-case-fold-search) |
710 (keywords (cdr (if (eq (car-safe font-lock-keywords) t) | 715 (keywords (cdr (if (eq (car-safe font-lock-keywords) t) |
711 font-lock-keywords | 716 font-lock-keywords |
712 (font-lock-compile-keywords)))) | 717 (font-lock-compile-keywords)))) |
713 (inhibit-read-only t) (buffer-undo-list t) | |
714 (modified (buffer-modified-p)) | |
715 (old-syntax (syntax-table)) | |
716 (bufname (buffer-name)) (count 0) | 718 (bufname (buffer-name)) (count 0) |
717 buffer-file-name buffer-file-truename) | 719 keyword matcher highlights) |
718 (unwind-protect | 720 ;; |
719 (let (keyword matcher highlights) | 721 ;; Fontify each item in `font-lock-keywords' from `start' to `end'. |
720 ;; | 722 (while keywords |
721 ;; Use the fontification syntax table, if any. | 723 (if loudly (message "Fontifying %s... (regexps..%s)" bufname |
722 (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) | 724 (make-string (setq count (1+ count)) ?.))) |
723 ;; | |
724 ;; Fontify each item in `font-lock-keywords' from `start' to `end'. | |
725 (while keywords | |
726 (if loudly (message "Fontifying %s... (regexps..%s)" bufname | |
727 (make-string (setq count (1+ count)) ?.))) | |
728 ;; | |
729 ;; Find an occurrence of `matcher' from `start' to `end'. | |
730 (setq keyword (car keywords) matcher (car keyword)) | |
731 (goto-char start) | |
732 (while (if (stringp matcher) | |
733 (re-search-forward matcher end t) | |
734 (funcall matcher end)) | |
735 ;; Apply each highlight to this instance of `matcher', which may | |
736 ;; be specific highlights or more keywords anchored to `matcher'. | |
737 (setq highlights (cdr keyword)) | |
738 (while highlights | |
739 (if (numberp (car (car highlights))) | |
740 (font-lock-apply-highlight (car highlights)) | |
741 (font-lock-fontify-anchored-keywords (car highlights) end)) | |
742 (setq highlights (cdr highlights)))) | |
743 (setq keywords (cdr keywords)))) | |
744 ;; | 725 ;; |
745 ;; Clean up. | 726 ;; Find an occurrence of `matcher' from `start' to `end'. |
746 (set-syntax-table old-syntax) | 727 (setq keyword (car keywords) matcher (car keyword)) |
747 (and (buffer-modified-p) | 728 (goto-char start) |
748 (not modified) | 729 (while (if (stringp matcher) |
749 (set-buffer-modified-p nil))))) | 730 (re-search-forward matcher end t) |
731 (funcall matcher end)) | |
732 ;; Apply each highlight to this instance of `matcher', which may be | |
733 ;; specific highlights or more keywords anchored to `matcher'. | |
734 (setq highlights (cdr keyword)) | |
735 (while highlights | |
736 (if (numberp (car (car highlights))) | |
737 (font-lock-apply-highlight (car highlights)) | |
738 (font-lock-fontify-anchored-keywords (car highlights) end)) | |
739 (setq highlights (cdr highlights)))) | |
740 (setq keywords (cdr keywords))))) | |
750 | 741 |
751 ;; Various functions. | 742 ;; Various functions. |
752 | 743 |
753 ;; Turn off other related packages if they're on. I prefer a hook. --sm. | 744 ;; Turn off other related packages if they're on. I prefer a hook. --sm. |
754 ;; These explicit calls are easier to understand | 745 ;; These explicit calls are easier to understand |
1004 (concat "Face.Attribute" resource))))) | 995 (concat "Face.Attribute" resource))))) |
1005 (on-p (function (lambda (face-name resource) | 996 (on-p (function (lambda (face-name resource) |
1006 (let ((set (funcall set-p face-name resource))) | 997 (let ((set (funcall set-p face-name resource))) |
1007 (and set (member (downcase set) '("on" "true")))))))) | 998 (and set (member (downcase set) '("on" "true")))))))) |
1008 (make-face face) | 999 (make-face face) |
1000 (add-to-list 'facemenu-unlisted-faces face) | |
1009 ;; Set attributes not set from X resources (and therefore `make-face'). | 1001 ;; Set attributes not set from X resources (and therefore `make-face'). |
1010 (or (funcall set-p face-name "Foreground") | 1002 (or (funcall set-p face-name "Foreground") |
1011 (condition-case nil | 1003 (condition-case nil |
1012 (set-face-foreground face (nth 1 face-attributes)) | 1004 (set-face-foreground face (nth 1 face-attributes)) |
1013 (error nil))) | 1005 (error nil))) |
1170 ;; are expected to be separated with a "," or ";". | 1162 ;; are expected to be separated with a "," or ";". |
1171 (if (looking-at "[ \t*&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*\\((\\)?") | 1163 (if (looking-at "[ \t*&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*\\((\\)?") |
1172 (save-match-data | 1164 (save-match-data |
1173 (condition-case nil | 1165 (condition-case nil |
1174 (save-restriction | 1166 (save-restriction |
1175 ;; Restrict ourselves to the end of the line. | 1167 ;; Restrict to the end of line, currently guaranteed to be LIMIT. |
1176 (end-of-line) | 1168 (narrow-to-region (point-min) limit) |
1177 (narrow-to-region (point-min) (min limit (point))) | |
1178 (goto-char (match-end 1)) | 1169 (goto-char (match-end 1)) |
1179 ;; Move over any item value, etc., to the next item. | 1170 ;; Move over any item value, etc., to the next item. |
1180 (while (not (looking-at "[ \t]*\\([,;]\\|$\\)")) | 1171 (while (not (looking-at "[ \t]*\\([,;]\\|$\\)")) |
1181 (goto-char (or (scan-sexps (point) 1) (point-max)))) | 1172 (goto-char (or (scan-sexps (point) 1) (point-max)))) |
1182 (goto-char (match-end 0))) | 1173 (goto-char (match-end 0))) |