aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2010-12-06 11:51:37 -0500
committerStefan Monnier2010-12-06 11:51:37 -0500
commitce327e48a158a1b59c6ccf54c26763c3460ca268 (patch)
tree6e004331a9f573d8a88cbac7959952d3f38a65ef
parentbba3e50834d3957fe2b6f345075a6f38839de4bc (diff)
downloademacs-ce327e48a158a1b59c6ccf54c26763c3460ca268.tar.gz
emacs-ce327e48a158a1b59c6ccf54c26763c3460ca268.zip
* lisp/ansi-color.el (ansi-color-unfontify-region): Replace by trivial def.
(ansi-color-filter-apply): Simplify. (ansi-color-apply): Use `font-lock-face' rather than `face'.
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/ansi-color.el61
2 files changed, 13 insertions, 54 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 650d7a097b8..1c838c574d4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
12010-12-06 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * ansi-color.el (ansi-color-unfontify-region): Replace by trivial def.
4 (ansi-color-filter-apply): Simplify.
5 (ansi-color-apply): Use `font-lock-face' rather than `face'.
6
12010-12-05 Bob Rogers <rogers-emacs@rgrjr.dyndns.org> 72010-12-05 Bob Rogers <rogers-emacs@rgrjr.dyndns.org>
2 8
3 * vc/vc-dir.el (vc-dir-query-replace-regexp): Doc fix (Bug#7501). 9 * vc/vc-dir.el (vc-dir-query-replace-regexp): Doc fix (Bug#7501).
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 6bc95fa8d94..98eeca325b2 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -215,48 +215,10 @@ This is a good function to put in `comint-output-filter-functions'."
215(add-hook 'comint-output-filter-functions 215(add-hook 'comint-output-filter-functions
216 'ansi-color-process-output) 216 'ansi-color-process-output)
217 217
218 218(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region)
219;; Alternative font-lock-unfontify-region-function for Emacs only 219(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1")
220
221(defun ansi-color-unfontify-region (beg end &rest xemacs-stuff)
222 "Replacement function for `font-lock-default-unfontify-region'.
223
224As text properties are implemented using extents in XEmacs, this
225function is probably not needed. In Emacs, however, things are a bit
226different: When font-lock is active in a buffer, you cannot simply add
227face text properties to the buffer. Font-lock will remove the face
228text property using `font-lock-unfontify-region-function'. If you want
229to insert the strings returned by `ansi-color-apply' into such buffers,
230you must set `font-lock-unfontify-region-function' to
231`ansi-color-unfontify-region'. This function will not remove all face
232text properties unconditionally. It will keep the face text properties
233if the property `ansi-color' is set.
234
235The region from BEG to END is unfontified. XEMACS-STUFF is ignored.
236
237A possible way to install this would be:
238
239\(add-hook 'font-lock-mode-hook
240 \(function (lambda ()
241 \(setq font-lock-unfontify-region-function
242 'ansi-color-unfontify-region))))"
243 ;; Simplified now that font-lock-unfontify-region uses save-buffer-state.
244 (when (boundp 'font-lock-syntactic-keywords)
245 (remove-text-properties beg end '(syntax-table nil)))
246 ;; instead of just using (remove-text-properties beg end '(face
247 ;; nil)), we find regions with a non-nil face text-property, skip
248 ;; positions with the ansi-color property set, and remove the
249 ;; remaining face text-properties.
250 (while (setq beg (text-property-not-all beg end 'face nil))
251 (setq beg (or (text-property-not-all beg end 'ansi-color t) end))
252 (when (get-text-property beg 'face)
253 (let ((end-face (or (text-property-any beg end 'face nil)
254 end)))
255 (remove-text-properties beg end-face '(face nil))
256 (setq beg end-face)))))
257 220
258;; Working with strings 221;; Working with strings
259
260(defvar ansi-color-context nil 222(defvar ansi-color-context nil
261 "Context saved between two calls to `ansi-color-apply'. 223 "Context saved between two calls to `ansi-color-apply'.
262This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of 224This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of
@@ -290,9 +252,7 @@ This function can be added to `comint-preoutput-filter-functions'."
290 (setq fragment (substring string pos) 252 (setq fragment (substring string pos)
291 result (concat result (substring string start pos)))) 253 result (concat result (substring string start pos))))
292 (setq result (concat result (substring string start)))) 254 (setq result (concat result (substring string start))))
293 (if fragment 255 (setq ansi-color-context (if fragment (list nil fragment))))
294 (setq ansi-color-context (list nil fragment))
295 (setq ansi-color-context nil)))
296 result)) 256 result))
297 257
298(defun ansi-color-apply (string) 258(defun ansi-color-apply (string)
@@ -309,10 +269,7 @@ Every call to this function will set and use the buffer-local variable
309This information will be used for the next call to `ansi-color-apply'. 269This information will be used for the next call to `ansi-color-apply'.
310Set `ansi-color-context' to nil if you don't want this. 270Set `ansi-color-context' to nil if you don't want this.
311 271
312This function can be added to `comint-preoutput-filter-functions'. 272This function can be added to `comint-preoutput-filter-functions'."
313
314You cannot insert the strings returned into buffers using font-lock.
315See `ansi-color-unfontify-region' for a way around this."
316 (let ((face (car ansi-color-context)) 273 (let ((face (car ansi-color-context))
317 (start 0) end escape-sequence result 274 (start 0) end escape-sequence result
318 colorized-substring) 275 colorized-substring)
@@ -325,8 +282,7 @@ See `ansi-color-unfontify-region' for a way around this."
325 (setq escape-sequence (match-string 1 string)) 282 (setq escape-sequence (match-string 1 string))
326 ;; Colorize the old block from start to end using old face. 283 ;; Colorize the old block from start to end using old face.
327 (when face 284 (when face
328 (put-text-property start end 'ansi-color t string) 285 (put-text-property start end 'font-lock-face face string))
329 (put-text-property start end 'face face string))
330 (setq colorized-substring (substring string start end) 286 (setq colorized-substring (substring string start end)
331 start (match-end 0)) 287 start (match-end 0))
332 ;; Eliminate unrecognized ANSI sequences. 288 ;; Eliminate unrecognized ANSI sequences.
@@ -338,8 +294,7 @@ See `ansi-color-unfontify-region' for a way around this."
338 (setq face (ansi-color-apply-sequence escape-sequence face))) 294 (setq face (ansi-color-apply-sequence escape-sequence face)))
339 ;; if the rest of the string should have a face, put it there 295 ;; if the rest of the string should have a face, put it there
340 (when face 296 (when face
341 (put-text-property start (length string) 'ansi-color t string) 297 (put-text-property start (length string) 'font-lock-face face string))
342 (put-text-property start (length string) 'face face string))
343 ;; save context, add the remainder of the string to the result 298 ;; save context, add the remainder of the string to the result
344 (let (fragment) 299 (let (fragment)
345 (if (string-match "\033" string start) 300 (if (string-match "\033" string start)
@@ -347,9 +302,7 @@ See `ansi-color-unfontify-region' for a way around this."
347 (setq fragment (substring string pos)) 302 (setq fragment (substring string pos))
348 (push (substring string start pos) result)) 303 (push (substring string start pos) result))
349 (push (substring string start) result)) 304 (push (substring string start) result))
350 (if (or face fragment) 305 (setq ansi-color-context (if (or face fragment) (list face fragment))))
351 (setq ansi-color-context (list face fragment))
352 (setq ansi-color-context nil)))
353 (apply 'concat (nreverse result)))) 306 (apply 'concat (nreverse result))))
354 307
355;; Working with regions 308;; Working with regions