Mercurial > hg > xemacs-beta

comparison lisp/font-lock.el @ 430:a5df635868b2 r21-2-23

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-23
author cvs
date Mon, 13 Aug 2007 11:29:08 +0200
parents 3ecd8885ac67
children 3a7e78e1142d
comparison
equal deleted inserted replaced
429:8305706cbb93 430:a5df635868b2
1282 ; (setq prev nil))) 1282 ; (setq prev nil)))
1283 ; ;; 1283 ; ;;
1284 ; ;; Clean up. 1284 ; ;; Clean up.
1285 ; (and prev (remove-text-properties prev end '(face nil))))) 1285 ; (and prev (remove-text-properties prev end '(face nil)))))
1286 1286
1287 (defun font-lock-lisp-like (mode)
1288 ;; Note: (or (get mode 'font-lock-lisp-like) (string-match ...)) is
1289 ;; not enough because the property needs to be able to specify a nil
1290 ;; value.
1291 (if (plist-member (symbol-plist mode) 'font-lock-lisp-like)
1292 (get mode 'font-lock-lisp-like)
1293 ;; If the property is not specified, guess. Similar logic exists
1294 ;; in add-log, but I think this encompasses more modes.
1295 (string-match "lisp\\|scheme" (symbol-name mode))))
1296
1287 (defun font-lock-fontify-syntactically-region (start end &optional loudly) 1297 (defun font-lock-fontify-syntactically-region (start end &optional loudly)
1288 "Put proper face on each string and comment between START and END. 1298 "Put proper face on each string and comment between START and END.
1289 START should be at the beginning of a line." 1299 START should be at the beginning of a line."
1290 (if font-lock-keywords-only 1300 (if font-lock-keywords-only
1291 nil 1301 nil
1294 (lmessage 'progress "Fontifying %s... (syntactically...)" 1304 (lmessage 'progress "Fontifying %s... (syntactically...)"
1295 (buffer-name))) 1305 (buffer-name)))
1296 (font-lock-unfontify-region start end loudly) 1306 (font-lock-unfontify-region start end loudly)
1297 (goto-char start) 1307 (goto-char start)
1298 (if (> end (point-max)) (setq end (point-max))) 1308 (if (> end (point-max)) (setq end (point-max)))
1299 (syntactically-sectionize 1309 (let ((lisp-like (font-lock-lisp-like major-mode)))
1300 #'(lambda (s e context depth) 1310 (syntactically-sectionize
1301 (let (face) 1311 #'(lambda (s e context depth)
1302 (cond ((eq context 'string) 1312 (let (face)
1303 ;;#### Should only do this is Lisp-like modes! 1313 (cond ((eq context 'string)
1304 (setq face 1314 (setq face
1305 (if (= depth 1) 1315 ;; #### It would be nice if we handled
1306 ;; really we should only use this if 1316 ;; Python and other non-Lisp languages with
1307 ;; in position 3 depth 1, but that's 1317 ;; docstrings correctly.
1308 ;; too expensive to compute. 1318 (if (and lisp-like (= depth 1))
1309 'font-lock-doc-string-face 1319 ;; really we should only use this if
1310 'font-lock-string-face))) 1320 ;; in position 3 depth 1, but that's
1311 ((or (eq context 'comment) 1321 ;; too expensive to compute.
1312 (eq context 'block-comment)) 1322 'font-lock-doc-string-face
1313 (setq face 'font-lock-comment-face) 1323 'font-lock-string-face)))
1324 ((or (eq context 'comment)
1325 (eq context 'block-comment))
1326 (setq face 'font-lock-comment-face)
1314 ; ;; Don't fontify whitespace at the beginning of lines; 1327 ; ;; Don't fontify whitespace at the beginning of lines;
1315 ; ;; otherwise comment blocks may not line up with code. 1328 ; ;; otherwise comment blocks may not line up with code.
1316 ; ;; (This is sometimes a good idea, sometimes not; in any 1329 ; ;; (This is sometimes a good idea, sometimes not; in any
1317 ; ;; event it should be in C for speed --jwz) 1330 ; ;; event it should be in C for speed --jwz)
1318 ; (save-excursion 1331 ; (save-excursion
1321 ; (setq face 'font-lock-comment-face) 1334 ; (setq face 'font-lock-comment-face)
1322 ; (setq e (point))) 1335 ; (setq e (point)))
1323 ; (skip-chars-forward " \t\n") 1336 ; (skip-chars-forward " \t\n")
1324 ; (setq s (point))) 1337 ; (setq s (point)))
1325 )) 1338 ))
1326 (font-lock-set-face s e face))) 1339 (font-lock-set-face s e face)))
1327 start end) 1340 start end)
1328 )) 1341 )))
1329 1342
1330 ;;; Additional text property functions. 1343 ;;; Additional text property functions.
1331 1344
1332 ;; The following three text property functions are not generally available (and 1345 ;; The following three text property functions are not generally available (and
1333 ;; it's not certain that they should be) so they are inlined for speed. 1346 ;; it's not certain that they should be) so they are inlined for speed.