Mercurial > hg > xemacs-beta
comparison lisp/unicode.el @ 4571:ebc01476e352
Merge.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 30 Dec 2008 20:33:30 +0000 |
| parents | e6a7054a9c30 |
| children | e0a8715fdb1f |
comparison
equal
deleted
inserted
replaced
| 4548:b0d2ace4aed1 | 4571:ebc01476e352 |
|---|---|
| 611 begin end buffer)) | 611 begin end buffer)) |
| 612 | 612 |
| 613 ;; Sure would be nice to be able to use defface here. | 613 ;; Sure would be nice to be able to use defface here. |
| 614 (copy-face 'highlight 'unicode-invalid-sequence-warning-face) | 614 (copy-face 'highlight 'unicode-invalid-sequence-warning-face) |
| 615 | 615 |
| 616 (defvar unicode-query-coding-skip-chars-arg nil ;; Set in general-late.el | |
| 617 "Used by `unicode-query-coding-region' to skip chars with known mappings.") | |
| 618 | |
| 619 (defun unicode-query-coding-region (begin end coding-system | |
| 620 &optional buffer errorp highlightp) | |
| 621 "The `query-coding-region' implementation for Unicode coding systems." | |
| 622 (check-argument-type #'coding-system-p | |
| 623 (setq coding-system (find-coding-system coding-system))) | |
| 624 (check-argument-type #'integer-or-marker-p begin) | |
| 625 (check-argument-type #'integer-or-marker-p end) | |
| 626 (let* ((skip-chars-arg unicode-query-coding-skip-chars-arg) | |
| 627 (ranges (make-range-table)) | |
| 628 (looking-at-arg (concat "[" skip-chars-arg "]")) | |
| 629 fail-range-start fail-range-end char-after failed | |
| 630 extent) | |
| 631 (save-excursion | |
| 632 (when highlightp | |
| 633 (map-extents #'(lambda (extent ignored-arg) | |
| 634 (when (eq 'query-coding-warning-face | |
| 635 (extent-face extent)) | |
| 636 (delete-extent extent))) buffer begin end)) | |
| 637 (goto-char begin buffer) | |
| 638 (skip-chars-forward skip-chars-arg end buffer) | |
| 639 (while (< (point buffer) end) | |
| 640 ; (message | |
| 641 ; "fail-range-start is %S, point is %S, end is %S" | |
| 642 ; fail-range-start (point buffer) end) | |
| 643 (setq char-after (char-after (point buffer) buffer) | |
| 644 fail-range-start (point buffer)) | |
| 645 (while (and | |
| 646 (< (point buffer) end) | |
| 647 (not (looking-at looking-at-arg)) | |
| 648 (= -1 (char-to-unicode char-after))) | |
| 649 (forward-char 1 buffer) | |
| 650 (setq char-after (char-after (point buffer) buffer) | |
| 651 failed t)) | |
| 652 (if (= fail-range-start (point buffer)) | |
| 653 ;; The character can actually be encoded by the coding | |
| 654 ;; system; check the characters past it. | |
| 655 (forward-char 1 buffer) | |
| 656 ;; Can't be encoded; note this. | |
| 657 (when errorp | |
| 658 (error 'text-conversion-error | |
| 659 (format "Cannot encode %s using coding system" | |
| 660 (buffer-substring fail-range-start (point buffer) | |
| 661 buffer)) | |
| 662 (coding-system-name coding-system))) | |
| 663 (put-range-table fail-range-start | |
| 664 ;; If char-after is non-nil, we're not at | |
| 665 ;; the end of the buffer. | |
| 666 (setq fail-range-end (if char-after | |
| 667 (point buffer) | |
| 668 (point-max buffer))) | |
| 669 t ranges) | |
| 670 (when highlightp | |
| 671 (setq extent (make-extent fail-range-start fail-range-end buffer)) | |
| 672 (set-extent-priority extent (+ mouse-highlight-priority 2)) | |
| 673 (set-extent-face extent 'query-coding-warning-face))) | |
| 674 (skip-chars-forward skip-chars-arg end buffer)) | |
| 675 (if failed | |
| 676 (values nil ranges) | |
| 677 (values t nil))))) | |
| 678 | |
| 679 (loop | |
| 680 for coding-system in (coding-system-list) | |
| 681 initially (unless (featurep 'mule) (return)) | |
| 682 do (when (eq 'unicode (coding-system-type coding-system)) | |
| 683 (coding-system-put coding-system 'query-coding-function | |
| 684 #'unicode-query-coding-region))) | |
| 685 | |
| 616 (unless (featurep 'mule) | 686 (unless (featurep 'mule) |
| 617 ;; We do this in such a roundabout way--instead of having the above defun | 687 ;; We do this in such a roundabout way--instead of having the above defun |
| 618 ;; and defvar calls inside a (when (featurep 'mule) ...) form--to have | 688 ;; and defvar calls inside a (when (featurep 'mule) ...) form--to have |
| 619 ;; make-docfile.c pick up symbol and function documentation correctly. An | 689 ;; make-docfile.c pick up symbol and function documentation correctly. An |
| 620 ;; alternative approach would be to fix make-docfile.c to be able to read | 690 ;; alternative approach would be to fix make-docfile.c to be able to read |
| 621 ;; Lisp. | 691 ;; Lisp. |
| 622 (mapcar #'unintern | 692 (mapcar #'unintern |
| 623 '(ccl-encode-to-ucs-2 unicode-error-default-translation-table | 693 '(ccl-encode-to-ucs-2 unicode-error-default-translation-table |
| 624 unicode-invalid-regexp-range frob-unicode-errors-region | 694 unicode-invalid-regexp-range frob-unicode-errors-region |
| 625 unicode-error-translate-region))) | 695 unicode-error-translate-region unicode-query-coding-region |
| 696 unicode-query-coding-skip-chars-arg))) | |
| 626 | 697 |
| 627 ;; #### UTF-7 is not yet implemented, and it's tricky to do. There's | 698 ;; #### UTF-7 is not yet implemented, and it's tricky to do. There's |
| 628 ;; an implementation in appendix A.1 of the Unicode Standard, Version | 699 ;; an implementation in appendix A.1 of the Unicode Standard, Version |
| 629 ;; 2.0, but I don't know its licensing characteristics. | 700 ;; 2.0, but I don't know its licensing characteristics. |
| 630 | 701 |