Mercurial > hg > xemacs-beta

comparison lisp/coding.el @ 4609:33b8c874b2c8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Correct string offset and arg handling, #'query-coding-string and related. lisp/ChangeLog addition: 2009-02-11 Aidan Kehoe <kehoea@parhasard.net> * coding.el (query-coding-string): Correct the order of arguments passed to #'query-coding-region. (unencodable-char-position): Handle string offsets correctly, they're one less than buffer offsets. Handle START and END correctly if passed a string.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 11 Feb 2009 12:11:26 +0000
parents e0a8715fdb1f
children 8cbca852bcd4
comparison
equal deleted inserted replaced
4608:1e3cf11fa27d 4609:33b8c874b2c8
505 (when highlight 505 (when highlight
506 (query-coding-clear-highlights 0 (length string) string)) 506 (query-coding-clear-highlights 0 (length string) string))
507 (insert string) 507 (insert string)
508 (multiple-value-bind (result ranges extent) 508 (multiple-value-bind (result ranges extent)
509 (query-coding-region (point-min) (point-max) coding-system 509 (query-coding-region (point-min) (point-max) coding-system
510 (current-buffer) errorp 510 (current-buffer) ignore-invalid-sequencesp
511 nil ignore-invalid-sequencesp) 511 errorp)
512 (unless result 512 (unless result
513 (map-range-table 513 (map-range-table
514 #'(lambda (begin end value) 514 #'(lambda (begin end value)
515 ;; Sigh, string indices are zero-based, buffer offsets are 515 ;; Sigh, string indices are zero-based, buffer offsets are
516 ;; one-based. 516 ;; one-based.
537 537
538 If optional 5th argument STRING is non-nil, it is a string to search 538 If optional 5th argument STRING is non-nil, it is a string to search
539 for un-encodable characters. In that case, START and END are indexes 539 for un-encodable characters. In that case, START and END are indexes
540 in the string." 540 in the string."
541 (let ((thunk 541 (let ((thunk
542 #'(lambda (start end coding-system &optional count) 542 #'(lambda (start end coding-system stringp count)
543 (multiple-value-bind (result ranges) 543 (multiple-value-bind (result ranges)
544 (query-coding-region start end coding-system) 544 (query-coding-region start end coding-system)
545 (if result 545 (if result
546 nil 546 nil
547 (block worked-it-all-out 547 (block worked-it-all-out
548 (if count 548 (if count
549 (map-range-table 549 (map-range-table
550 #'(lambda (begin end value) 550 #'(lambda (begin end value)
551 (while (and (< begin end) 551 (while (and (< begin end)
552 (< (length result) count)) 552 (< (length result) count))
553 (push begin result) 553 (push (if stringp (1- begin) begin) result)
554 (incf begin)) 554 (incf begin))
555 (when (= (length result) count) 555 (when (= (length result) count)
556 (return-from worked-it-all-out result))) 556 (return-from worked-it-all-out result)))
557 ranges) 557 ranges)
558 (map-range-table 558 (map-range-table
559 #'(lambda (begin end value) 559 #'(lambda (begin end value)
560 (return-from worked-it-all-out begin)) 560 (return-from worked-it-all-out
561 (if stringp (1- begin) begin)))
561 ranges)) 562 ranges))
562 (assert (not (null count)) t 563 (assert (not (null count)) t
563 "We should never reach this point with null COUNT.") 564 "We should never reach this point with null COUNT.")
564 result)))))) 565 result))))))
565 (check-argument-type #'integer-or-marker-p start) 566 (check-argument-type #'integer-or-marker-p start)
570 (if (zerop count) (setq count 1))) 571 (if (zerop count) (setq count 1)))
571 (and string (check-argument-type #'stringp string)) 572 (and string (check-argument-type #'stringp string))
572 (if string 573 (if string
573 (with-temp-buffer 574 (with-temp-buffer
574 (insert string) 575 (insert string)
575 (funcall thunk start end coding-system count)) 576 (funcall thunk (1+ start) (1+ end) coding-system t count))
576 (funcall thunk start end coding-system count)))) 577 (funcall thunk start end coding-system nil count))))
577 578
578 ;; XEmacs; this is a GPLv3 function in coding.c in GNU. This is why we have 579 ;; XEmacs; this is a GPLv3 function in coding.c in GNU. This is why we have
579 ;; both a very divergent docstring and a very divergent implementation. 580 ;; both a very divergent docstring and a very divergent implementation.
580 (defun check-coding-systems-region (begin end coding-system-list) 581 (defun check-coding-systems-region (begin end coding-system-list)
581 "Can coding systems in CODING-SYSTEM-LIST encode text in a region? 582 "Can coding systems in CODING-SYSTEM-LIST encode text in a region?