Mercurial > hg > xemacs-beta

comparison lisp/font-lock.el @ 367:a4f53d9b3154 r21-1-13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-1-13
author cvs
date Mon, 13 Aug 2007 11:01:07 +0200
parents 8e84bee8ddd0
children cc15677e0335
comparison
equal deleted inserted replaced
366:83d76f480a59 367:a4f53d9b3154
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)
852 (font-lock-mode 1)) 853 (font-lock-mode 1))
853 854
854 ;;;###autoload 855 ;;;###autoload
855 (defun turn-off-font-lock () 856 (defun turn-off-font-lock ()
856 "Unconditionally turn off Font Lock mode." 857 "Unconditionally turn off Font Lock mode."
858 (interactive)
857 (font-lock-mode 0)) 859 (font-lock-mode 0))
858 860
859 ;;; FSF has here: 861 ;;; FSF has here:
860 862
861 ;; support for add-keywords, global-font-lock-mode and 863 ;; support for add-keywords, global-font-lock-mode and
1283 ; (setq prev nil))) 1285 ; (setq prev nil)))
1284 ; ;; 1286 ; ;;
1285 ; ;; Clean up. 1287 ; ;; Clean up.
1286 ; (and prev (remove-text-properties prev end '(face nil))))) 1288 ; (and prev (remove-text-properties prev end '(face nil)))))
1287 1289
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
1288 (defun font-lock-fontify-syntactically-region (start end &optional loudly) 1300 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
1289 "Put proper face on each string and comment between START and END. 1301 "Put proper face on each string and comment between START and END.
1290 START should be at the beginning of a line." 1302 START should be at the beginning of a line."
1291 (if font-lock-keywords-only 1303 (if font-lock-keywords-only
1292 nil 1304 nil
1295 (lmessage 'progress "Fontifying %s... (syntactically...)" 1307 (lmessage 'progress "Fontifying %s... (syntactically...)"
1296 (buffer-name))) 1308 (buffer-name)))
1297 (font-lock-unfontify-region start end loudly) 1309 (font-lock-unfontify-region start end loudly)
1298 (goto-char start) 1310 (goto-char start)
1299 (if (> end (point-max)) (setq end (point-max))) 1311 (if (> end (point-max)) (setq end (point-max)))
1300 (syntactically-sectionize 1312 (let ((lisp-like (font-lock-lisp-like major-mode)))
1301 #'(lambda (s e context depth) 1313 (syntactically-sectionize
1302 (let (face) 1314 #'(lambda (s e context depth)
1303 (cond ((eq context 'string) 1315 (let (face)
1304 ;;#### Should only do this is Lisp-like modes! 1316 (cond ((eq context 'string)
1305 (setq face 1317 (setq face
1306 (if (= depth 1) 1318 ;; #### It would be nice if we handled
1307 ;; really we should only use this if 1319 ;; Python and other non-Lisp languages with
1308 ;; in position 3 depth 1, but that's 1320 ;; docstrings correctly.
1309 ;; too expensive to compute. 1321 (if (and lisp-like (= depth 1))
1310 'font-lock-doc-string-face 1322 ;; really we should only use this if
1311 'font-lock-string-face))) 1323 ;; in position 3 depth 1, but that's
1312 ((or (eq context 'comment) 1324 ;; too expensive to compute.
1313 (eq context 'block-comment)) 1325 'font-lock-doc-string-face
1314 (setq face 'font-lock-comment-face) 1326 'font-lock-string-face)))
1327 ((or (eq context 'comment)
1328 (eq context 'block-comment))
1329 (setq face 'font-lock-comment-face)
1315 ; ;; Don't fontify whitespace at the beginning of lines; 1330 ; ;; Don't fontify whitespace at the beginning of lines;
1316 ; ;; otherwise comment blocks may not line up with code. 1331 ; ;; otherwise comment blocks may not line up with code.
1317 ; ;; (This is sometimes a good idea, sometimes not; in any 1332 ; ;; (This is sometimes a good idea, sometimes not; in any
1318 ; ;; event it should be in C for speed --jwz) 1333 ; ;; event it should be in C for speed --jwz)
1319 ; (save-excursion 1334 ; (save-excursion
1322 ; (setq face 'font-lock-comment-face) 1337 ; (setq face 'font-lock-comment-face)
1323 ; (setq e (point))) 1338 ; (setq e (point)))
1324 ; (skip-chars-forward " \t\n") 1339 ; (skip-chars-forward " \t\n")
1325 ; (setq s (point))) 1340 ; (setq s (point)))
1326 )) 1341 ))
1327 (font-lock-set-face s e face))) 1342 (font-lock-set-face s e face)))
1328 start end) 1343 start end)
1329 )) 1344 )))
1330 1345
1331 ;;; Additional text property functions. 1346 ;;; Additional text property functions.
1332 1347
1333 ;; The following three text property functions are not generally available (and 1348 ;; The following three text property functions are not generally available (and
1334 ;; it's not certain that they should be) so they are inlined for speed. 1349 ;; it's not certain that they should be) so they are inlined for speed.