Mercurial > hg > xemacs-beta
comparison lisp/unicode.el @ 4564:46ddeaa7c738
Automated merge with file:///Sources/xemacs-21.5-checked-out
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 18 Jul 2008 01:00:32 +0200 |
| parents | 017044266245 |
| children | 26aae3bacf99 |
comparison
equal
deleted
inserted
replaced
| 4479:4cb7c59b5201 | 4564:46ddeaa7c738 |
|---|---|
| 609 (frob-unicode-errors-region | 609 (frob-unicode-errors-region |
| 610 (lambda (start finish) | 610 (lambda (start finish) |
| 611 (translate-region start finish table)) | 611 (translate-region start finish table)) |
| 612 begin end buffer)) | 612 begin end buffer)) |
| 613 | 613 |
| 614 (defvar unicode-query-coding-skip-chars-arg nil ;; Set in general-late.el | |
| 615 "Used by `unicode-query-coding-region' to skip chars with known mappings.") | |
| 616 | |
| 617 (defun unicode-query-coding-region (begin end coding-system | |
| 618 &optional buffer errorp highlightp) | |
| 619 "The `query-coding-region' implementation for Unicode coding systems." | |
| 620 (check-argument-type #'coding-system-p | |
| 621 (setq coding-system (find-coding-system coding-system))) | |
| 622 (check-argument-type #'integer-or-marker-p begin) | |
| 623 (check-argument-type #'integer-or-marker-p end) | |
| 624 (let* ((skip-chars-arg unicode-query-coding-skip-chars-arg) | |
| 625 (ranges (make-range-table)) | |
| 626 (looking-at-arg (concat "[" skip-chars-arg "]")) | |
| 627 fail-range-start fail-range-end previous-fail char-after failed | |
| 628 extent) | |
| 629 (save-excursion | |
| 630 (when highlightp | |
| 631 (map-extents #'(lambda (extent ignored-arg) | |
| 632 (when (eq 'query-coding-warning-face | |
| 633 (extent-face extent)) | |
| 634 (delete-extent extent))) buffer begin end)) | |
| 635 (goto-char begin buffer) | |
| 636 (skip-chars-forward skip-chars-arg end buffer) | |
| 637 (while (< (point buffer) end) | |
| 638 ; (message | |
| 639 ; "fail-range-start is %S, previous-fail %S, point is %S, end is %S" | |
| 640 ; fail-range-start previous-fail (point buffer) end) | |
| 641 (setq char-after (char-after (point buffer) buffer) | |
| 642 fail-range-start (point buffer)) | |
| 643 (while (and | |
| 644 (< (point buffer) end) | |
| 645 (not (looking-at looking-at-arg)) | |
| 646 (= -1 (char-to-unicode char-after))) | |
| 647 (forward-char 1 buffer) | |
| 648 (message "what?!?") | |
| 649 (setq char-after (char-after (point buffer) buffer) | |
| 650 failed t)) | |
| 651 (if (= fail-range-start (point buffer)) | |
| 652 ;; The character can actually be encoded by the coding | |
| 653 ;; system; check the characters past it. | |
| 654 (forward-char 1 buffer) | |
| 655 ;; Can't be encoded; note this. | |
| 656 (when errorp | |
| 657 (error 'text-conversion-error | |
| 658 (format "Cannot encode %s using coding system" | |
| 659 (buffer-substring fail-range-start (point buffer) | |
| 660 buffer)) | |
| 661 (coding-system-name coding-system))) | |
| 662 (put-range-table fail-range-start | |
| 663 ;; If char-after is non-nil, we're not at | |
| 664 ;; the end of the buffer. | |
| 665 (setq fail-range-end (if char-after | |
| 666 (point buffer) | |
| 667 (point-max buffer))) | |
| 668 t ranges) | |
| 669 (when highlightp | |
| 670 (setq extent (make-extent fail-range-start fail-range-end buffer)) | |
| 671 (set-extent-priority extent (+ mouse-highlight-priority 2)) | |
| 672 (set-extent-face extent 'query-coding-warning-face))) | |
| 673 (skip-chars-forward skip-chars-arg end buffer)) | |
| 674 (if failed | |
| 675 (values nil ranges) | |
| 676 (values t nil))))) | |
| 677 | |
| 678 (loop | |
| 679 for coding-system in (coding-system-list) | |
| 680 do (when (eq 'unicode (coding-system-type coding-system)) | |
| 681 (coding-system-put coding-system 'query-coding-function | |
| 682 #'unicode-query-coding-region))) | |
| 683 | |
| 614 (unless (featurep 'mule) | 684 (unless (featurep 'mule) |
| 615 ;; We do this in such a roundabout way--instead of having the above defun | 685 ;; We do this in such a roundabout way--instead of having the above defun |
| 616 ;; and defvar calls inside a (when (featurep 'mule) ...) form--to have | 686 ;; and defvar calls inside a (when (featurep 'mule) ...) form--to have |
| 617 ;; make-docfile.c pick up symbol and function documentation correctly. An | 687 ;; make-docfile.c pick up symbol and function documentation correctly. An |
| 618 ;; alternative approach would be to fix make-docfile.c to be able to read | 688 ;; alternative approach would be to fix make-docfile.c to be able to read |