Parent Directory | Revision Log | Patch
revision 1.141.2.26 by fx, Fri May 23 23:32:01 2003 UTC | revision 1.141.2.27 by handa, Wed May 28 11:41:17 2003 UTC | |
---|---|---|
# | Line 527 to lower case. | Line 527 to lower case. |
527 | `:mime-text-unsuitable' | `:mime-text-unsuitable' |
528 | ||
529 | VALUE non-nil means the `:mime-charset' property names a charset which | VALUE non-nil means the `:mime-charset' property names a charset which |
530 | is unsuitable for the top-level media type "text". | is unsuitable for the top-level media type \"text\". |
531 | ||
532 | `:flags' | `:flags' |
533 | ||
# | Line 954 Now we have more convenient function `se | Line 954 Now we have more convenient function `se |
954 | ||
955 | ;;; X selections | ;;; X selections |
956 | ||
957 | (defvar non-standard-icccm-encodings-alist | (defvar ctext-non-standard-encodings-alist |
958 | '(("ISO8859-15" . latin-iso8859-15) | '(("ISO8859-10" . iso-8859-10) |
959 | ("ISO8859-14" . latin-iso8859-14) | ("ISO8859-13" . iso-8859-13) |
960 | ("ISO8859-14" . iso-8859-14) | |
961 | ("ISO8859-15" . iso-8859-15) | |
962 | ("ISO8859-16" . iso-8859-16) | |
963 | ("KOI8-R" . koi8-r) | ("KOI8-R" . koi8-r) |
964 | ("BIG5-0" . big5)) | ("BIG5-0" . big5)) |
965 | "Alist of font charset names defined by XLFD, and the corresponding Emacs | "Alist of non-standard encoding names vs Emacs coding systems. |
966 | charsets or coding systems.") | This alist is used to decode an extened segment of a compound text.") |
;; Fixme: this needs sorting out | ||
967 | ||
968 | ;; Functions to support "Non-Standard Character Set Encodings" defined | ;; Functions to support "Non-Standard Character Set Encodings" defined |
969 | ;; by the ICCCM spec. We support that by converting the leading | ;; by the COMPOUND TEXT spec. |
970 | ;; sequence of the ``extended segment'' to the corresponding ISO-2022 | |
971 | ;; sequences (if the leading sequence names an Emacs charset), or decode | (defvar ctext-non-standard-encodings-regexp |
972 | ;; the segment (if it names a coding system). Encoding does the reverse. | (string-to-multibyte |
973 | (concat | |
974 | ;; For non-standard encodings. | |
975 | "\\(\e%/[0-4][\200-\377][\200-\377]\\([^\002]+\\)\002\\)" | |
976 | "\\|" | |
977 | ;; For UTF-8 encoding. | |
978 | "\\(\e%G[^\e]*\e%@\\)"))) | |
979 | ||
980 | (defun ctext-post-read-conversion (len) | (defun ctext-post-read-conversion (len) |
981 | "Decode LEN characters encoded as Compound Text with Extended Segments." | "Decode LEN characters encoded as Compound Text with Extended Segments." |
982 | (buffer-disable-undo) ; minimize consing due to insertions and deletions | ;; We don't need the following because it is expected that this |
983 | (narrow-to-region (point) (+ (point) len)) | ;; function is mainly used for decoding X selection which is not |
984 | ;; that big data. | |
985 | ;;(buffer-disable-undo) ; minimize consing due to insertions and deletions | |
986 | (save-match-data | (save-match-data |
987 | (let ((pt (point-marker)) | (save-restriction |
988 | (oldpt (point-marker)) | (narrow-to-region (point) (+ (point) len)) |
989 | (newpt (make-marker)) | (let ((case-fold-search nil) |
990 | (modified-p (buffer-modified-p)) | last-coding-system-used |
991 | (case-fold-search nil) | pos bytes) |
992 | last-coding-system-used | (decode-coding-region (point-min) (point-max) 'ctext) |
993 | encoding textlen chset) | (while (re-search-forward ctext-non-standard-encodings-regexp |
994 | (while (re-search-forward | nil 'move) |
995 | "\\(\e\\)%/[0-4]\\([\200-\377][\200-\377]\\)\\([^\002]+\\)\002" | (setq pos (match-beginning 0)) |
996 | nil 'move) | (if (match-beginning 1) |
997 | (set-marker newpt (point)) | ;; ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES-- |
998 | (set-marker pt (match-beginning 0)) | (let* ((M (char-after (+ pos 4))) |
999 | (setq encoding (match-string 3)) | (L (char-after (+ pos 5))) |
1000 | (setq textlen (- (+ (* (- (aref (match-string 2) 0) 128) 128) | (encoding (match-string 2)) |
1001 | (- (aref (match-string 2) 1) 128)) | (coding (or (cdr (assoc-ignore-case |
1002 | (1+ (length encoding)))) | encoding |
1003 | (setq | ctext-non-standard-encodings-alist)) |
1004 | chset (cdr (assoc-ignore-case encoding | (coding-system-p |
1005 | non-standard-icccm-encodings-alist))) | (intern (downcase encoding)))))) |
1006 | (cond ((null chset) | (if enable-multibyte-characters |
1007 | ;; This charset is not supported--leave this extended | (setq M (multibyte-char-to-unibyte M) |
1008 | ;; segment unaltered and skip over it. | L (multibyte-char-to-unibyte L))) |
1009 | (goto-char (+ (point) textlen))) | (setq bytes (- (+ (* (- M 128) 128) (- L 128)) |
1010 | ((charsetp chset) | (- (point) (+ pos 6)))) |
1011 | ;; If it's a charset, replace the leading escape sequence | (when coding |
1012 | ;; with a standard ISO-2022 sequence. We will decode all | (delete-region pos (point)) |
1013 | ;; such segments later, in one go, when we exit the loop | (forward-char bytes) |
1014 | ;; or find an extended segment that names a coding | (decode-coding-region (- (point) bytes) (point) coding))) |
1015 | ;; system, not a charset. | ;; ESC % G --UTF-8-BYTES-- ESC % @ |
1016 | (replace-match | (setq bytes (- (point) pos)) |
1017 | (concat "\\1" | (decode-coding-region (- (point) bytes) (point) 'utf-8)))) |
1018 | (if (= 0 (charset-iso-graphic-plane chset)) | (goto-char (point-min)) |
1019 | ;; GL charsets | (- (point-max) (point))))) |
(if (= 1 (charset-dimension chset)) "(" "$(") | ||
;; GR charsets | ||
(if (= 96 (charset-chars chset)) | ||
"-" | ||
(if (= 1 (charset-dimension chset)) ")" "$)"))) | ||
(string (charset-iso-final-char chset))) | ||
t) | ||
(goto-char (+ (point) textlen))) | ||
((coding-system-p chset) | ||
;; If it's a coding system, we need to decode the segment | ||
;; right away. But first, decode what we've skipped | ||
;; across until now. | ||
(when (> pt oldpt) | ||
(decode-coding-region oldpt pt 'ctext-no-compositions)) | ||
(delete-region pt newpt) | ||
(set-marker newpt (+ newpt textlen)) | ||
(decode-coding-region pt newpt chset) | ||
(goto-char newpt) | ||
(set-marker oldpt newpt)))) | ||
;; Decode what's left. | ||
(when (> (point) oldpt) | ||
(decode-coding-region oldpt (point) 'ctext-no-compositions)) | ||
;; This buffer started as unibyte, because the string we get from | ||
;; the X selection is a unibyte string. We must now make it | ||
;; multibyte, so that the decoded text is inserted as multibyte | ||
;; into its buffer. | ||
(set-buffer-multibyte t) | ||
(set-buffer-modified-p modified-p) | ||
(- (point-max) (point-min))))) | ||
1020 | ||
1021 | (defvar non-standard-designations-alist | (defvar ctext-non-standard-designations-alist |
1022 | '(("$(0" . (big5 "big5-0" 2)) | '(("$(0" . (big5 "big5-0" 2)) |
1023 | ("$(1" . (big5 "big5-0" 2)) | ("$(1" . (big5 "big5-0" 2)) |
1024 | ("-V" . (t "iso8859-10" 1)) | ("-V" . (t "iso8859-10" 1)) |
# | Line 1045 charsets or coding systems.") | Line 1026 charsets or coding systems.") |
1026 | ("-_" . (t "iso8859-14" 1)) | ("-_" . (t "iso8859-14" 1)) |
1027 | ("-b" . (t "iso8859-15" 1)) | ("-b" . (t "iso8859-15" 1)) |
1028 | ("-f" . (t "iso8859-16" 1))) | ("-f" . (t "iso8859-16" 1))) |
1029 | "Alist of ctext control sequences that introduce character sets which | "Alist of ctext control sequences that introduce character sets |
1030 | are not in the list of approved ICCCM encodings, and the corresponding | which are not in the list of approved COMPOUND TEXT encodings, and the |
1031 | coding system, identifier string, and number of octets per encoded | corresponding coding system, identifier string, and number of octets |
1032 | character. | per encoded character. |
1033 | ||
1034 | Each element has the form (CTLSEQ . (ENCODING CHARSET NOCTETS)). CTLSEQ | Each element has the form (CTLSEQ . (ENCODING CHARSET NOCTETS)). CTLSEQ |
1035 | is the control sequence (sans the leading ESC) that introduces the character | is the control sequence (sans the leading ESC) that introduces the character |
# | Line 1067 of octets per character is variable), 1, | Line 1048 of octets per character is variable), 1, |
1048 | If FROM is a string, or if the current buffer is not the one set up for us | If FROM is a string, or if the current buffer is not the one set up for us |
1049 | by run_pre_post_conversion_on_str, generate a new temp buffer, insert the | by run_pre_post_conversion_on_str, generate a new temp buffer, insert the |
1050 | text, and convert it in the temporary buffer. Otherwise, convert in-place." | text, and convert it in the temporary buffer. Otherwise, convert in-place." |
(cond ((and (string= (buffer-name) " *code-converting-work*") | ||
(not (stringp from))) | ||
; Minimize consing due to subsequent insertions and deletions. | ||
(buffer-disable-undo) | ||
(narrow-to-region from to)) | ||
(t | ||
(let ((buf (current-buffer))) | ||
(set-buffer (generate-new-buffer " *temp")) | ||
(buffer-disable-undo) | ||
(if (stringp from) | ||
(insert from) | ||
(insert-buffer-substring buf from to))))) | ||
(encode-coding-region from to 'ctext-no-compositions) | ||
;; Replace ISO-2022 charset designations with extended segments, for | ||
;; those charsets that are not part of the official X registry. | ||
1051 | (save-match-data | (save-match-data |
1052 | (goto-char (point-min)) | (save-restriction |
1053 | (let ((newpt (make-marker)) | (narrow-to-region from to) |
1054 | (case-fold-search nil) | (goto-char from) |
1055 | pt desig encode-info encoding chset noctets textlen) | (encode-coding-region from to 'ctext-no-compositions) |
1056 | (set-buffer-multibyte nil) | (set-buffer-multibyte nil) |
1057 | ;; The regexp below finds the leading sequences for big5 and | ;; Replace ISO-2022 charset designations with extended segments, |
1058 | ;; iso8859-1[03-6] charsets. | ;; for those charsets that are not part of the official X |
1059 | (while (re-search-forward "\e\\(\$([01]\\|-[VY_bf]\\)" nil 'move) | ;; registry. |
1060 | (setq desig (match-string 1) | (let ((case-fold-search nil) |
1061 | pt (point-marker) | pos posend desig encode-info encoding chset noctets textlen) |
1062 | encode-info (cdr (assoc desig non-standard-designations-alist)) | ;; The regexp below finds the leading sequences for big5 and |
1063 | encoding (car encode-info) | ;; iso8859-1[03-6] charsets. |
1064 | chset (cadr encode-info) | (while (re-search-forward "\e\\(\$([01]\\|-[VY_bf]\\)" nil 'move) |
1065 | noctets (car (cddr encode-info))) | (setq pos (match-beginning 0) |
1066 | (skip-chars-forward "^\e") | posend (point) |
1067 | (set-marker newpt (point)) | desig (match-string 1) |
1068 | (cond | encode-info (cdr (assoc desig |
1069 | ((eq encoding t) ; only the leading sequence needs to be changed | ctext-non-standard-designations-alist)) |
1070 | (setq textlen (+ (- newpt pt) (length chset) 1)) | encoding (car encode-info) |
1071 | ;; Generate the ICCCM control sequence for an extended segment. | chset (cadr encode-info) |
1072 | (replace-match (format "\e%%/%d%c%c%s\ " |
noctets (car (cddr encode-info))) |
1073 | noctets | (skip-chars-forward "^\e") |
1074 | (+ (/ textlen 128) 128) | (cond |
1075 | (+ (% textlen 128) 128) | ((eq encoding t) ; only the leading sequence needs to be changed |
1076 | chset) | (setq textlen (+ (- (point) posend) (length chset) 1)) |
1077 | t t)) | ;; Generate the ICCCM control sequence for an extended segment. |
1078 | ((coding-system-p encoding) ; need to recode the entire segment... | (replace-match (format "\e%%/%d%c%c%s\ " |
1079 | (set-marker pt (match-beginning 0)) | noctets |
1080 | (decode-coding-region pt newpt 'ctext-no-compositions) | (+ (/ textlen 128) 128) |
1081 | (set-buffer-multibyte t) | (+ (% textlen 128) 128) |
1082 | (encode-coding-region pt newpt encoding) | chset) |
1083 | (set-buffer-multibyte nil) | t t)) |
1084 | (setq textlen (+ (- newpt pt) (length chset) 1)) | ((coding-system-p encoding) ; need to recode the entire segment... |
1085 | (goto-char pt) | (decode-coding-region pos (point) 'ctext-no-compositions) |
1086 | (insert (format "\e%%/%d%c%c%s\ " |
(encode-coding-region pos (point) encoding) |
1087 | noctets | (setq textlen (+ (- (point) pos) (length chset) 1)) |
1088 | (+ (/ textlen 128) 128) | (save-excursion |
1089 | (+ (% textlen 128) 128) | (goto-char pos) |
1090 | chset)))) | (insert (format "\e%%/%d%c%c%s\ " |
1091 | (goto-char newpt)))) | noctets |
1092 | (set-buffer-multibyte t) | (+ (/ textlen 128) 128) |
1093 | ;; Must return nil, as build_annotations_2 expects that. | (+ (% textlen 128) 128) |
1094 | nil) | chset))))))) |
1095 | (goto-char (point-min))))) | |
1096 | ||
1097 | (make-obsolete 'set-coding-priority 'set-coding-system-priority "22.1") | (make-obsolete 'set-coding-priority 'set-coding-system-priority "22.1") |
1098 |
|
savannah-hackers-public@gnu.org | ViewVC Help |
Powered by ViewVC 1.1.26 |