comparison lisp/coding.el @ 4555:20c32e489235

Add #'query-coding-clear-highlights. 2008-05-11 Aidan Kehoe <kehoea@parhasard.net> * coding.el (query-coding-clear-highlights): New function--clear any face information added by `query-coding-region'. (default-query-coding-region): Use it.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 11 May 2008 19:50:10 +0200
parents 75654496fa0e
children 46ddeaa7c738
comparison
equal deleted inserted replaced
4554:4953b7353349 4555:20c32e489235
284 284
285 (defvar default-query-coding-region-safe-charset-skip-chars-map 285 (defvar default-query-coding-region-safe-charset-skip-chars-map
286 #s(hash-table test equal data ()) 286 #s(hash-table test equal data ())
287 "A map from list of charsets to `skip-chars-forward' arguments for them.") 287 "A map from list of charsets to `skip-chars-forward' arguments for them.")
288 288
289 (defsubst query-coding-clear-highlights (begin end &optional buffer)
290 "Remove extent faces added by `query-coding-region' between BEGIN and END.
291
292 Optional argument BUFFER is the buffer to use, and defaults to the current
293 buffer.
294
295 The HIGHLIGHTP argument to `query-coding-region' indicates that it should
296 display unencodable characters using `query-coding-warning-face'. After
297 this function has been called, this will no longer be the case. "
298 (map-extents #'(lambda (extent ignored-arg)
299 (when (eq 'query-coding-warning-face
300 (extent-face extent))
301 (delete-extent extent))) buffer begin end))
302
289 (defun default-query-coding-region (begin end coding-system 303 (defun default-query-coding-region (begin end coding-system
290 &optional buffer errorp highlightp) 304 &optional buffer errorp highlightp)
291 "The default `query-coding-region' implementation. 305 "The default `query-coding-region' implementation.
292 306
293 Uses the `safe-charsets' and `safe-chars' coding system properties. 307 Uses the `safe-charsets' and `safe-chars' coding system properties.
317 (puthash safe-charsets 331 (puthash safe-charsets
318 (mapconcat #'charset-skip-chars-string 332 (mapconcat #'charset-skip-chars-string
319 safe-charsets "") 333 safe-charsets "")
320 default-query-coding-region-safe-charset-skip-chars-map))) 334 default-query-coding-region-safe-charset-skip-chars-map)))
321 (when highlightp 335 (when highlightp
322 (map-extents #'(lambda (extent ignored-arg) 336 (query-coding-clear-highlights begin end buffer))
323 (when (eq 'query-coding-warning-face
324 (extent-face extent))
325 (delete-extent extent))) buffer begin end))
326 (if (and (zerop (length skip-chars-arg)) (null safe-chars)) 337 (if (and (zerop (length skip-chars-arg)) (null safe-chars))
327 (progn 338 (progn
328 ;; Uh-oh, nothing known about this coding system. Fail. 339 ;; Uh-oh, nothing known about this coding system. Fail.
329 (when errorp 340 (when errorp
330 (error 'text-conversion-error 341 (error 'text-conversion-error
382 (skip-chars-forward skip-chars-arg end buffer)) 393 (skip-chars-forward skip-chars-arg end buffer))
383 (if failed 394 (if failed
384 (values nil ranges) 395 (values nil ranges)
385 (values t nil)))))) 396 (values t nil))))))
386 397
387 (defsubst query-coding-region (start end coding-system &optional buffer 398 (defun query-coding-region (start end coding-system &optional buffer
388 errorp highlight) 399 errorp highlight)
389 "Work out whether CODING-SYSTEM can losslessly encode a region. 400 "Work out whether CODING-SYSTEM can losslessly encode a region.
390 401
391 START and END are the beginning and end of the region to check. 402 START and END are the beginning and end of the region to check.
392 CODING-SYSTEM is the coding system to try. 403 CODING-SYSTEM is the coding system to try.