Mercurial > hg > xemacs-beta
comparison lisp/unicode.el @ 4566:26aae3bacf99
Merge.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 09 Aug 2008 13:11:06 +0200 |
| parents | 121aadac896e 017044266245 |
| children | 1d74a1d115ee |
comparison
equal
deleted
inserted
replaced
| 4565:31344162cf9a | 4566:26aae3bacf99 |
|---|---|
| 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 previous-fail 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, previous-fail %S, point is %S, end is %S" | |
| 642 ; fail-range-start previous-fail (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 (message "what?!?") | |
| 651 (setq char-after (char-after (point buffer) buffer) | |
| 652 failed t)) | |
| 653 (if (= fail-range-start (point buffer)) | |
| 654 ;; The character can actually be encoded by the coding | |
| 655 ;; system; check the characters past it. | |
| 656 (forward-char 1 buffer) | |
| 657 ;; Can't be encoded; note this. | |
| 658 (when errorp | |
| 659 (error 'text-conversion-error | |
| 660 (format "Cannot encode %s using coding system" | |
| 661 (buffer-substring fail-range-start (point buffer) | |
| 662 buffer)) | |
| 663 (coding-system-name coding-system))) | |
| 664 (put-range-table fail-range-start | |
| 665 ;; If char-after is non-nil, we're not at | |
| 666 ;; the end of the buffer. | |
| 667 (setq fail-range-end (if char-after | |
| 668 (point buffer) | |
| 669 (point-max buffer))) | |
| 670 t ranges) | |
| 671 (when highlightp | |
| 672 (setq extent (make-extent fail-range-start fail-range-end buffer)) | |
| 673 (set-extent-priority extent (+ mouse-highlight-priority 2)) | |
| 674 (set-extent-face extent 'query-coding-warning-face))) | |
| 675 (skip-chars-forward skip-chars-arg end buffer)) | |
| 676 (if failed | |
| 677 (values nil ranges) | |
| 678 (values t nil))))) | |
| 679 | |
| 680 (loop | |
| 681 for coding-system in (coding-system-list) | |
| 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 |