Mercurial > hg > xemacs-beta

comparison lisp/coding.el @ 4596:4fc32a3a086e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix a couple of bugs, #'query-coding-region, #'query-coding-string. 2009-02-04 Aidan Kehoe <kehoea@parhasard.net> * coding.el (query-coding-region): Revert this to being a defun, add a compiler macro without needless binding. (query-coding-string): Correct a bug here, string indices are zero- not one-based. * mule/general-late.el (unicode-query-coding-skip-chars-arg): Correct the algorithm used to initialise this variable.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 04 Feb 2009 12:14:38 +0000
parents e6a7054a9c30
children 8891b0477058
comparison
equal deleted inserted replaced
4595:a1a8728fec10 4596:4fc32a3a086e
396 (skip-chars-forward skip-chars-arg end buffer)) 396 (skip-chars-forward skip-chars-arg end buffer))
397 (if failed 397 (if failed
398 (values nil ranges) 398 (values nil ranges)
399 (values t nil)))))) 399 (values t nil))))))
400 400
401 (defsubst query-coding-region (start end coding-system &optional buffer 401 (defun query-coding-region (start end coding-system &optional buffer
402 errorp highlight) 402 errorp highlight)
403 "Work out whether CODING-SYSTEM can losslessly encode a region. 403 "Work out whether CODING-SYSTEM can losslessly encode a region.
404 404
405 START and END are the beginning and end of the region to check. 405 START and END are the beginning and end of the region to check.
406 CODING-SYSTEM is the coding system to try. 406 CODING-SYSTEM is the coding system to try.
407 407
421 `make-range-table'." 421 `make-range-table'."
422 (funcall (or (coding-system-get coding-system 'query-coding-function) 422 (funcall (or (coding-system-get coding-system 'query-coding-function)
423 #'default-query-coding-region) 423 #'default-query-coding-region)
424 start end coding-system buffer errorp highlight)) 424 start end coding-system buffer errorp highlight))
425 425
426 (defsubst query-coding-string (string coding-system &optional errorp highlight) 426 (define-compiler-macro query-coding-region (start end coding-system
427 &optional buffer errorp highlight)
428 `(funcall (or (coding-system-get ,coding-system 'query-coding-function)
429 #'default-query-coding-region)
430 ,start ,end ,coding-system ,@(append (if buffer (list buffer))
431 (if errorp (list errorp))
432 (if highlight (list highlight)))))
433
434 (defun query-coding-string (string coding-system &optional errorp highlight)
427 "Work out whether CODING-SYSTEM can losslessly encode STRING. 435 "Work out whether CODING-SYSTEM can losslessly encode STRING.
428 CODING-SYSTEM is the coding system to check. 436 CODING-SYSTEM is the coding system to check.
429 437
430 Optional argument ERRORP says to signal a `text-conversion-error' if some 438 Optional argument ERRORP says to signal a `text-conversion-error' if some
431 character in the region cannot be encoded, and defaults to nil. 439 character in the region cannot be encoded, and defaults to nil.
440 can be encoded using CODING-SYSTEM; otherwise, it is a range table 448 can be encoded using CODING-SYSTEM; otherwise, it is a range table
441 describing the positions of the unencodable characters. See 449 describing the positions of the unencodable characters. See
442 `make-range-table'." 450 `make-range-table'."
443 (with-temp-buffer 451 (with-temp-buffer
444 (insert string) 452 (insert string)
445 (query-coding-region (point-min) (point-max) coding-system (current-buffer) 453 (multiple-value-bind (result ranges)
446 ;; ### Will highlight work here? 454 (query-coding-region (point-min) (point-max) coding-system
447 errorp highlight))) 455 (current-buffer) errorp
456 ;; #### Highlight won't work here,
457 ;; query-coding-region may need to be modified.
458 highlight)
459 (unless result
460 ;; Sigh, string indices are zero-based, buffer offsets are
461 ;; one-based.
462 (map-range-table
463 #'(lambda (begin end value)
464 (remove-range-table begin end ranges)
465 (put-range-table (1- begin) (1- end) value ranges))
466 ranges))
467 (values result ranges))))
448 468
449 ;; Function docstring and API are taken from GNU coding.c version 1.353, GPLv2. 469 ;; Function docstring and API are taken from GNU coding.c version 1.353, GPLv2.
450 (defun unencodable-char-position (start end coding-system 470 (defun unencodable-char-position (start end coding-system
451 &optional count string) 471 &optional count string)
452 "Return position of first un-encodable character in a region. 472 "Return position of first un-encodable character in a region.