comparison lisp/font-lock.el @ 371:cc15677e0335 r21-2b1

Import from CVS: tag r21-2b1
author cvs
date Mon, 13 Aug 2007 11:03:08 +0200
parents a4f53d9b3154
children 6240c7796c7a
comparison
equal deleted inserted replaced
370:bd866891f083 371:cc15677e0335
847 847
848 ;; For init-file hooks 848 ;; For init-file hooks
849 ;;;###autoload 849 ;;;###autoload
850 (defun turn-on-font-lock () 850 (defun turn-on-font-lock ()
851 "Unconditionally turn on Font Lock mode." 851 "Unconditionally turn on Font Lock mode."
852 (interactive)
853 (font-lock-mode 1)) 852 (font-lock-mode 1))
854 853
855 ;;;###autoload 854 ;;;###autoload
856 (defun turn-off-font-lock () 855 (defun turn-off-font-lock ()
857 "Unconditionally turn off Font Lock mode." 856 "Unconditionally turn off Font Lock mode."
858 (interactive)
859 (font-lock-mode 0)) 857 (font-lock-mode 0))
860 858
861 ;;; FSF has here: 859 ;;; FSF has here:
862 860
863 ;; support for add-keywords, global-font-lock-mode and 861 ;; support for add-keywords, global-font-lock-mode and
1073 (defun font-lock-fontify-glumped-region () 1071 (defun font-lock-fontify-glumped-region ()
1074 ;; even if something goes wrong in the fontification, mark the glumped 1072 ;; even if something goes wrong in the fontification, mark the glumped
1075 ;; region as fontified; otherwise, the same error might get signaled 1073 ;; region as fontified; otherwise, the same error might get signaled
1076 ;; after every command. 1074 ;; after every command.
1077 (unwind-protect 1075 (unwind-protect
1078 ;; buffer/extent may be deleted. 1076 ;; buffer may be deleted.
1079 (if (and (extent-live-p font-lock-old-extent) 1077 (if (buffer-live-p (extent-object font-lock-old-extent))
1080 (buffer-live-p (extent-object font-lock-old-extent)))
1081 (save-excursion 1078 (save-excursion
1082 (set-buffer (extent-object font-lock-old-extent)) 1079 (set-buffer (extent-object font-lock-old-extent))
1083 (font-lock-after-change-function-1 1080 (font-lock-after-change-function-1
1084 (extent-start-position font-lock-old-extent) 1081 (extent-start-position font-lock-old-extent)
1085 (extent-end-position font-lock-old-extent) 1082 (extent-end-position font-lock-old-extent)
1285 ; (setq prev nil))) 1282 ; (setq prev nil)))
1286 ; ;; 1283 ; ;;
1287 ; ;; Clean up. 1284 ; ;; Clean up.
1288 ; (and prev (remove-text-properties prev end '(face nil))))) 1285 ; (and prev (remove-text-properties prev end '(face nil)))))
1289 1286
1290 (defun font-lock-lisp-like (mode)
1291 ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is
1292 ;; not enough because the property needs to be able to specify a nil
1293 ;; value.
1294 (if (plist-member (symbol-plist mode) 'font-lock-lisp-like)
1295 (get mode 'font-lock-lisp-like)
1296 ;; If the property is not specified, guess. Similar logic exists
1297 ;; in add-log, but I think this encompasses more modes.
1298 (string-match "lisp\\|scheme" (symbol-name mode))))
1299
1300 (defun font-lock-fontify-syntactically-region (start end &optional loudly) 1287 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
1301 "Put proper face on each string and comment between START and END. 1288 "Put proper face on each string and comment between START and END.
1302 START should be at the beginning of a line." 1289 START should be at the beginning of a line."
1303 (if font-lock-keywords-only 1290 (if font-lock-keywords-only
1304 nil 1291 nil
1307 (lmessage 'progress "Fontifying %s... (syntactically...)" 1294 (lmessage 'progress "Fontifying %s... (syntactically...)"
1308 (buffer-name))) 1295 (buffer-name)))
1309 (font-lock-unfontify-region start end loudly) 1296 (font-lock-unfontify-region start end loudly)
1310 (goto-char start) 1297 (goto-char start)
1311 (if (> end (point-max)) (setq end (point-max))) 1298 (if (> end (point-max)) (setq end (point-max)))
1312 (let ((lisp-like (font-lock-lisp-like major-mode))) 1299 (syntactically-sectionize
1313 (syntactically-sectionize 1300 #'(lambda (s e context depth)
1314 #'(lambda (s e context depth) 1301 (let (face)
1315 (let (face) 1302 (cond ((eq context 'string)
1316 (cond ((eq context 'string) 1303 ;;#### Should only do this is Lisp-like modes!
1317 (setq face 1304 (setq face
1318 ;; #### It would be nice if we handled 1305 (if (= depth 1)
1319 ;; Python and other non-Lisp languages with 1306 ;; really we should only use this if
1320 ;; docstrings correctly. 1307 ;; in position 3 depth 1, but that's
1321 (if (and lisp-like (= depth 1)) 1308 ;; too expensive to compute.
1322 ;; really we should only use this if 1309 'font-lock-doc-string-face
1323 ;; in position 3 depth 1, but that's 1310 'font-lock-string-face)))
1324 ;; too expensive to compute. 1311 ((or (eq context 'comment)
1325 'font-lock-doc-string-face 1312 (eq context 'block-comment))
1326 'font-lock-string-face))) 1313 (setq face 'font-lock-comment-face)
1327 ((or (eq context 'comment)
1328 (eq context 'block-comment))
1329 (setq face 'font-lock-comment-face)
1330 ; ;; Don't fontify whitespace at the beginning of lines; 1314 ; ;; Don't fontify whitespace at the beginning of lines;
1331 ; ;; otherwise comment blocks may not line up with code. 1315 ; ;; otherwise comment blocks may not line up with code.
1332 ; ;; (This is sometimes a good idea, sometimes not; in any 1316 ; ;; (This is sometimes a good idea, sometimes not; in any
1333 ; ;; event it should be in C for speed --jwz) 1317 ; ;; event it should be in C for speed --jwz)
1334 ; (save-excursion 1318 ; (save-excursion
1337 ; (setq face 'font-lock-comment-face) 1321 ; (setq face 'font-lock-comment-face)
1338 ; (setq e (point))) 1322 ; (setq e (point)))
1339 ; (skip-chars-forward " \t\n") 1323 ; (skip-chars-forward " \t\n")
1340 ; (setq s (point))) 1324 ; (setq s (point)))
1341 )) 1325 ))
1342 (font-lock-set-face s e face))) 1326 (font-lock-set-face s e face)))
1343 start end) 1327 start end)
1344 ))) 1328 ))
1345 1329
1346 ;;; Additional text property functions. 1330 ;;; Additional text property functions.
1347 1331
1348 ;; The following three text property functions are not generally available (and 1332 ;; The following three text property functions are not generally available (and
1349 ;; it's not certain that they should be) so they are inlined for speed. 1333 ;; it's not certain that they should be) so they are inlined for speed.
1550 (defun font-lock-revert-setup () 1534 (defun font-lock-revert-setup ()
1551 (setq font-lock-fontified nil)) 1535 (setq font-lock-fontified nil))
1552 1536
1553 ;; If the buffer has just been reverted, normally that turns off 1537 ;; If the buffer has just been reverted, normally that turns off
1554 ;; Font Lock mode. So turn the mode back on if necessary. 1538 ;; Font Lock mode. So turn the mode back on if necessary.
1555 ;; sb 1999-03-03 -- The above comment no longer appears to be operative as 1539 (defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
1556 ;; the first call to normal-mode *will* restore the font-lock state and
1557 ;; this call forces a second font-locking to occur when reverting a buffer,
1558 ;; which is wasteful at best.
1559 ;(defalias 'font-lock-revert-cleanup 'turn-on-font-lock)
1560 (defun font-lock-revert-cleanup ())
1561 1540
1562 1541
1563 ;; Various functions. 1542 ;; Various functions.
1564 1543
1565 (defun font-lock-compile-keywords (&optional keywords) 1544 (defun font-lock-compile-keywords (&optional keywords)
2336 ;; Special constants: 2315 ;; Special constants:
2337 '("\\<\\(this\\|super\\)\\>" (1 font-lock-reference-face)) 2316 '("\\<\\(this\\|super\\)\\>" (1 font-lock-reference-face))
2338 '("\\<\\(false\\|null\\|true\\)\\>" (1 font-lock-keyword-face)) 2317 '("\\<\\(false\\|null\\|true\\)\\>" (1 font-lock-keyword-face))
2339 2318
2340 ;; Class names: 2319 ;; Class names:
2341 (list (concat "\\<\\(class\\|interface\\)\\>\\s *" 2320 (list (concat "\\<class\\>\\s *" java-font-lock-identifier-regexp)
2342 java-font-lock-identifier-regexp) 2321 1 'font-lock-function-name-face)
2343 2 'font-lock-function-name-face)
2344 2322
2345 ;; Package declarations: 2323 ;; Package declarations:
2346 (list (concat "\\<\\(package\\|import\\)\\>\\s *" 2324 (list (concat "\\<\\(package\\|import\\)\\>\\s *"
2347 java-font-lock-identifier-regexp) 2325 java-font-lock-identifier-regexp)
2348 '(2 font-lock-reference-face) 2326 '(2 font-lock-reference-face)
2476 ("\\<public\\>" 0 font-lock-reference-face)) 2454 ("\\<public\\>" 0 font-lock-reference-face))
2477 java-font-lock-keywords-2 2455 java-font-lock-keywords-2
2478 2456
2479 (list 2457 (list
2480 2458
2481 ;; Javadoc tags 2459 ;; Java doc tags
2482 '("@\\(author\\|exception\\|throws\\|deprecated\\|param\\|return\\|see\\|since\\|version\\)\\s " 2460 '("@\\(author\\|exception\\|param\\|return\\|see\\|version\\)\\s "
2483 0 font-lock-keyword-face t) 2461 0 font-lock-keyword-face t)
2484 2462
2485 ;; Doc tag - Parameter identifiers 2463 ;; Doc tag - Parameter identifiers
2486 (list (concat "@param\\s +" java-font-lock-identifier-regexp) 2464 (list (concat "@param\\s +" java-font-lock-identifier-regexp)
2487 1 'font-lock-variable-name-face t) 2465 1 'font-lock-variable-name-face t)
2488 2466
2489 ;; Doc tag - Exception types 2467 ;; Doc tag - Exception types
2490 (list (concat "@\\(exception\\|throws\\)\\s +" 2468 (list (concat "@exception\\ s*"
2491 java-font-lock-identifier-regexp) 2469 java-font-lock-identifier-regexp)
2492 '(2 (if (equal (char-after (match-end 0)) ?.) 2470 '(1 (if (equal (char-after (match-end 0)) ?.)
2493 font-lock-reference-face font-lock-type-face) t) 2471 font-lock-reference-face font-lock-type-face) t)
2494 (list (concat "\\=\\." java-font-lock-identifier-regexp) 2472 (list (concat "\\=\\." java-font-lock-identifier-regexp)
2495 '(goto-char (match-end 0)) nil 2473 '(goto-char (match-end 0)) nil
2496 '(1 (if (equal (char-after (match-end 0)) ?.) 2474 '(1 (if (equal (char-after (match-end 0)) ?.)
2497 'font-lock-reference-face 'font-lock-type-face) t))) 2475 'font-lock-reference-face 'font-lock-type-face) t)))
2498 2476
2499 ;; Doc tag - Cross-references, usually to methods 2477 ;; Doc tag - Cross-references, usually to methods
2500 '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)" 2478 '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)"
2501 1 font-lock-function-name-face t)
2502
2503 ;; Doc tag - docRoot (1.3)
2504 '("\\({ *@docRoot *}\\)"
2505 0 font-lock-keyword-face t)
2506 ;; Doc tag - beaninfo, unofficial but widely used, even by Sun
2507 '("\\(@beaninfo\\)"
2508 0 font-lock-keyword-face t)
2509 ;; Doc tag - Links
2510 '("{ *@link\\s +\\([^}]+\\)}"
2511 0 font-lock-keyword-face t)
2512 ;; Doc tag - Links
2513 '("{ *@link\\s +\\(\\(\\S +\\)\\|\\(\\S +\\s +\\S +\\)\\) *}"
2514 1 font-lock-function-name-face t) 2479 1 font-lock-function-name-face t)
2515 2480
2516 ))) 2481 )))
2517 ) 2482 )
2518 2483