Mercurial > hg > xemacs-beta
comparison lisp/unicode.el @ 4569:80e0588fb42f
Merge.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 28 Dec 2008 14:55:02 +0000 |
| parents | 1d74a1d115ee |
| children | e6a7054a9c30 |
comparison
equal
deleted
inserted
replaced
| 4537:7ca6d57ce12d | 4569:80e0588fb42f |
|---|---|
| 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 do (when (eq 'unicode (coding-system-type coding-system)) | |
| 682 (coding-system-put coding-system 'query-coding-function | |
| 683 #'unicode-query-coding-region))) | |
| 684 | |
| 616 (unless (featurep 'mule) | 685 (unless (featurep 'mule) |
| 617 ;; We do this in such a roundabout way--instead of having the above defun | 686 ;; 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 | 687 ;; and defvar calls inside a (when (featurep 'mule) ...) form--to have |
| 619 ;; make-docfile.c pick up symbol and function documentation correctly. An | 688 ;; 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 | 689 ;; alternative approach would be to fix make-docfile.c to be able to read |