/[emacs]/emacs/lisp/international/mule-cmds.el
ViewVC logotype

Diff of /emacs/lisp/international/mule-cmds.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.194.2.1 by miles, Fri Apr 4 06:20:22 2003 UTC revision 1.194.2.2 by miles, Tue Oct 14 23:39:23 2003 UTC
# Line 1  Line 1 
1  ;;; mule-cmds.el --- commands for mulitilingual environment  ;;; mule-cmds.el --- commands for mulitilingual environment -*-coding: iso-2022-7bit -*-
2  ;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.  ;; Copyright (C) 1995, 2003 Electrotechnical Laboratory, JAPAN.
3  ;; Licensed to the Free Software Foundation.  ;; Licensed to the Free Software Foundation.
4  ;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.  ;; Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
5    
# Line 64  Line 64 
64  (define-key-after mule-menu-keymap [set-language-environment]  (define-key-after mule-menu-keymap [set-language-environment]
65    (list 'menu-item  "Set Language Environment" setup-language-environment-map    (list 'menu-item  "Set Language Environment" setup-language-environment-map
66          :help "Multilingual environment suitable for a specific language"))          :help "Multilingual environment suitable for a specific language"))
 (define-key-after mule-menu-keymap [mouse-set-font]  
   '(menu-item "Set Font/Fontset" mouse-set-font  
                :visible (fboundp 'generate-fontset-menu)  
                :help "Select a font from list of known fonts/fontsets"))  
67  (define-key-after mule-menu-keymap [separator-mule]  (define-key-after mule-menu-keymap [separator-mule]
68    '("--")    '("--")
69    t)    t)
# Line 84  Line 80 
80    t)    t)
81  (define-key-after mule-menu-keymap [set-various-coding-system]  (define-key-after mule-menu-keymap [set-various-coding-system]
82    (list 'menu-item "Set Coding Systems" set-coding-system-map    (list 'menu-item "Set Coding Systems" set-coding-system-map
83          :enable 'enable-multibyte-characters))          :enable 'default-enable-multibyte-characters))
84  (define-key-after mule-menu-keymap [view-hello-file]  (define-key-after mule-menu-keymap [view-hello-file]
85    '(menu-item "Show Multi-lingual Text" view-hello-file    '(menu-item "Show Multi-lingual Text" view-hello-file
86                :enable (file-readable-p                :enable (file-readable-p
# Line 416  If the variable `sort-coding-systems-pre Line 412  If the variable `sort-coding-systems-pre
412  non-nil, it is used to sort CODINGS in the different way than above."  non-nil, it is used to sort CODINGS in the different way than above."
413    (if sort-coding-systems-predicate    (if sort-coding-systems-predicate
414        (sort codings sort-coding-systems-predicate)        (sort codings sort-coding-systems-predicate)
415      (let* ((most-preferred (symbol-value (car coding-category-list)))      (let* ((from-categories (mapcar #'(lambda (x) (symbol-value x))
416                                        coding-category-list))
417               (most-preferred (car from-categories))
418             (lang-preferred (get-language-info current-language-environment             (lang-preferred (get-language-info current-language-environment
419                                                'coding-system))                                                'coding-system))
420             (func (function             (func (function
421                    (lambda (x)                    (lambda (x)
422                      (let ((base (coding-system-base x)))                      (let ((base (coding-system-base x)))
423                        (+ (if (eq base most-preferred) 64 0)                        ;; We calculate the priority number 0..255 by
424                           (let ((mime (coding-system-get base 'mime-charset)))                        ;; using the 8 bits PMMLCEII as this:
425                          ;; P: 1 iff most preferred.
426                          ;; MM: greater than 0 iff mime-charset.
427                          ;; L: 1 iff one of the current lang. env.'s codings.
428                          ;; C: 1 iff one of codings listed in the category list.
429                          ;; E: 1 iff not XXX-with-esc
430                          ;; II: if iso-2022 based, 0..3, else 1.
431                          (logior
432                           (lsh (if (eq base most-preferred) 1 0) 7)
433                           (lsh
434                            (let ((mime (coding-system-get base 'mime-charset)))
435                             ;; Prefer coding systems corresponding to a                             ;; Prefer coding systems corresponding to a
436                             ;; MIME charset.                             ;; MIME charset.
437                             (if mime                             (if mime
438                                 ;; Lower utf-16 priority so that we                                 ;; Lower utf-16 priority so that we
439                                 ;; normally prefer utf-8 to it, and put                                 ;; normally prefer utf-8 to it, and put
440                                 ;; x-ctext below that.                                 ;; x-ctext below that.
441                                 (cond ((or (eq base 'mule-utf-16-le)                                 (cond ((string-match "utf-16"
442                                            (eq base 'mule-utf-16-be))                                                      (symbol-name mime))
443                                        16)                                        2)
444                                       ((string-match "^x-" (symbol-name mime))                                       ((string-match "^x-" (symbol-name mime))
445                                        8)                                        1)
446                                       (t 32))                                       (t 3))
447                               0))                               0))
448                           (if (memq base lang-preferred) 8 0)                          5)
449                           (if (string-match "-with-esc\\'" (symbol-name base))                         (lsh (if (memq base lang-preferred) 1 0) 4)
450                               0 4)                         (lsh (if (memq base from-categories) 1 0) 3)
451                           (if (eq (coding-system-type base) 2)                         (lsh (if (string-match "-with-esc\\'"
452                               ;; For ISO based coding systems, prefer                                                (symbol-name base))
453                               ;; one that doesn't use escape sequences.                                  0 1) 2)
454                               (let ((flags (coding-system-flags base)))                         (if (eq (coding-system-type base) 2)
455                                 (if (or (consp (aref flags 0))                             ;; For ISO based coding systems, prefer
456                                         (consp (aref flags 1))                             ;; one that doesn't use escape sequences.
457                                         (consp (aref flags 2))                             (let ((flags (coding-system-flags base)))
458                                         (consp (aref flags 3)))                               (if (or (consp (aref flags 0))
459                                     (if (or (aref flags 8) (aref flags 9))                                       (consp (aref flags 1))
460                                         0                                       (consp (aref flags 2))
461                                       1)                                       (consp (aref flags 3)))
462                                   2))                                   (if (or (aref flags 8) (aref flags 9))
463                             1)))))))                                       0
464                                       1)
465                                   2))
466                             1)))))))
467        (sort codings (function (lambda (x y)        (sort codings (function (lambda (x y)
468                                  (> (funcall func x) (funcall func y))))))))                                  (> (funcall func x) (funcall func y))))))))
469    
# Line 616  The candidates of coding systems which c Line 627  The candidates of coding systems which c
627  between FROM and TO are shown in a popup window.  Among them, the most  between FROM and TO are shown in a popup window.  Among them, the most
628  proper one is suggested as the default.  proper one is suggested as the default.
629    
630  The list of `buffer-file-coding-system' of the current buffer and the  The list of `buffer-file-coding-system' of the current buffer,
631    the `default-buffer-file-coding-system', and the
632  most preferred coding system (if it corresponds to a MIME charset) is  most preferred coding system (if it corresponds to a MIME charset) is
633  treated as the default coding system list.  Among them, the first one  treated as the default coding system list.  Among them, the first one
634  that safely encodes the text is normally selected silently and  that safely encodes the text is normally selected silently and
# Line 633  Optional 3rd arg DEFAULT-CODING-SYSTEM s Line 645  Optional 3rd arg DEFAULT-CODING-SYSTEM s
645  list of coding systems to be prepended to the default coding system  list of coding systems to be prepended to the default coding system
646  list.  However, if DEFAULT-CODING-SYSTEM is a list and the first  list.  However, if DEFAULT-CODING-SYSTEM is a list and the first
647  element is t, the cdr part is used as the defualt coding system list,  element is t, the cdr part is used as the defualt coding system list,
648  i.e. `buffer-file-coding-system' and the most prepended coding system  i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
649  is not used.  and the most preferred coding system are not used.
650    
651  Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to  Optional 4th arg ACCEPT-DEFAULT-P, if non-nil, is a function to
652  determine the acceptability of the silently selected coding system.  determine the acceptability of the silently selected coding system.
# Line 664  and TO is ignored." Line 676  and TO is ignored."
676            (mapcar (function (lambda (x) (cons x (coding-system-base x))))            (mapcar (function (lambda (x) (cons x (coding-system-base x))))
677                    default-coding-system))                    default-coding-system))
678    
679        ;; From now on, the list of defaults is reversed.
680        (setq default-coding-system (nreverse default-coding-system))
681    
682      (unless no-other-defaults      (unless no-other-defaults
683        ;; If buffer-file-coding-system is not nil nor undecided, append it        ;; If buffer-file-coding-system is not nil nor undecided, append it
684        ;; to the defaults.        ;; to the defaults.
# Line 671  and TO is ignored." Line 686  and TO is ignored."
686            (let ((base (coding-system-base buffer-file-coding-system)))            (let ((base (coding-system-base buffer-file-coding-system)))
687              (or (eq base 'undecided)              (or (eq base 'undecided)
688                  (rassq base default-coding-system)                  (rassq base default-coding-system)
689                  (setq default-coding-system                  (push (cons buffer-file-coding-system base)
690                        (append default-coding-system                        default-coding-system))))
691                                (list (cons buffer-file-coding-system base)))))))  
692          ;; If default-buffer-file-coding-system is not nil nor undecided,
693          ;; append it to the defaults.
694          (if default-buffer-file-coding-system
695              (let ((base (coding-system-base default-buffer-file-coding-system)))
696                (or (eq base 'undecided)
697                    (rassq base default-coding-system)
698                    (push (cons default-buffer-file-coding-system base)
699                          default-coding-system))))
700    
701        ;; If the most preferred coding system has the property mime-charset,        ;; If the most preferred coding system has the property mime-charset,
702        ;; append it to the defaults.        ;; append it to the defaults.
703        (let ((tail coding-category-list)        (let ((tail coding-category-list)
704              preferred base)              preferred base)
705          (while (and tail          (while (and tail (not (setq preferred (symbol-value (car tail)))))
                     (not (setq preferred (symbol-value (car tail)))))  
706            (setq tail (cdr tail)))            (setq tail (cdr tail)))
707          (and (coding-system-p preferred)          (and (coding-system-p preferred)
708               (setq base (coding-system-base preferred))               (setq base (coding-system-base preferred))
709               (coding-system-get preferred 'mime-charset)               (coding-system-get preferred 'mime-charset)
710               (not (rassq base default-coding-system))               (not (rassq base default-coding-system))
711               (setq default-coding-system               (push (cons preferred base)
712                     (append default-coding-system                     default-coding-system)))))
                            (list (cons preferred base))))))))  
713    
714    (if select-safe-coding-system-accept-default-p    (if select-safe-coding-system-accept-default-p
715        (setq accept-default-p select-safe-coding-system-accept-default-p))        (setq accept-default-p select-safe-coding-system-accept-default-p))
# Line 709  and TO is ignored." Line 730  and TO is ignored."
730                (push (car elt) safe))                (push (car elt) safe))
731            (push (car elt) unsafe)))            (push (car elt) unsafe)))
732        (if safe        (if safe
733            (setq coding-system (car (last safe)))))            (setq coding-system (car safe))))
734    
735      ;; If all the defaults failed, ask a user.      ;; If all the defaults failed, ask a user.
736      (when (not coding-system)      (when (not coding-system)
# Line 866  one of the following safe coding systems Line 887  one of the following safe coding systems
887                  (insert "\n")                  (insert "\n")
888                  (fill-region-as-paragraph pos (point)))                  (fill-region-as-paragraph pos (point)))
889                (insert "Or specify any other coding system                (insert "Or specify any other coding system
890  on your risk of losing the problematic characters.\n")))  at the risk of losing the problematic characters.\n")))
891    
892            ;; Read a coding system.            ;; Read a coding system.
893            (setq default-coding-system (or (car safe) (car codings)))            (setq default-coding-system (or (car safe) (car codings)))
# Line 1570  The default status is as follows: Line 1591  The default status is as follows:
1591    bound to each category are as follows    bound to each category are as follows
1592          coding category                 coding system          coding category                 coding system
1593          --------------------------------------------------          --------------------------------------------------
         coding-category-iso-8-2         iso-latin-1  
1594          coding-category-iso-8-1         iso-latin-1          coding-category-iso-8-1         iso-latin-1
1595            coding-category-iso-8-2         iso-latin-1
1596            coding-category-utf-8           mule-utf-8
1597            coding-category-utf-16-be       mule-utf-16be-with-signature
1598            coding-category-utf-16-le       mule-utf-16le-with-signature
1599          coding-category-iso-7-tight     iso-2022-jp          coding-category-iso-7-tight     iso-2022-jp
1600          coding-category-iso-7           iso-2022-7bit          coding-category-iso-7           iso-2022-7bit
1601          coding-category-iso-7-else      iso-2022-7bit-lock          coding-category-iso-7-else      iso-2022-7bit-lock
# Line 1581  The default status is as follows: Line 1605  The default status is as follows:
1605          coding-category-sjis            japanese-shift-jis          coding-category-sjis            japanese-shift-jis
1606          coding-category-big5            chinese-big5          coding-category-big5            chinese-big5
1607          coding-category-ccl             nil          coding-category-ccl             nil
1608          coding-category-binary          no-conversion          coding-category-binary          no-conversion"
         coding-category-utf-16-be       nil  
         coding-category-utf-16-le       nil  
         coding-category-utf-8           mule-utf-8"  
1609    (interactive)    (interactive)
1610    ;; This function formerly set default-enable-multibyte-characters to t,    ;; This function formerly set default-enable-multibyte-characters to t,
1611    ;; but that is incorrect.  It should not alter the unibyte/multibyte choice.    ;; but that is incorrect.  It should not alter the unibyte/multibyte choice.
# Line 1599  The default status is as follows: Line 1620  The default status is as follows:
1620          coding-category-raw-text        'raw-text          coding-category-raw-text        'raw-text
1621          coding-category-sjis            'japanese-shift-jis          coding-category-sjis            'japanese-shift-jis
1622          coding-category-big5            'chinese-big5          coding-category-big5            'chinese-big5
1623          coding-category-utf-16-be       nil          coding-category-utf-16-be       'mule-utf-16be-with-signature
1624          coding-category-utf-16-le       nil          coding-category-utf-16-le       'mule-utf-16le-with-signature
1625          coding-category-utf-8           'mule-utf-8          coding-category-utf-8           'mule-utf-8
1626          coding-category-ccl             nil          coding-category-ccl             nil
1627          coding-category-binary          'no-conversion)          coding-category-binary          'no-conversion)
# Line 1608  The default status is as follows: Line 1629  The default status is as follows:
1629    (set-coding-priority    (set-coding-priority
1630     '(coding-category-iso-8-1     '(coding-category-iso-8-1
1631       coding-category-iso-8-2       coding-category-iso-8-2
1632         coding-category-utf-8
1633         coding-category-utf-16-be
1634         coding-category-utf-16-le
1635       coding-category-iso-7-tight       coding-category-iso-7-tight
1636       coding-category-iso-7       coding-category-iso-7
1637       coding-category-iso-7-else       coding-category-iso-7-else
# Line 1617  The default status is as follows: Line 1641  The default status is as follows:
1641       coding-category-sjis       coding-category-sjis
1642       coding-category-big5       coding-category-big5
1643       coding-category-ccl       coding-category-ccl
1644       coding-category-binary       coding-category-binary))
      coding-category-utf-16-be  
      coding-category-utf-16-le  
      coding-category-utf-8))  
1645    
1646    (update-coding-systems-internal)    (update-coding-systems-internal)
1647    
# Line 1663  The default status is as follows: Line 1684  The default status is as follows:
1684    (let ((coding (get-language-info language-name 'unibyte-display)))    (let ((coding (get-language-info language-name 'unibyte-display)))
1685      (if coding      (if coding
1686          (standard-display-european-internal)          (standard-display-european-internal)
1687        (standard-display-default (if (eq window-system 'pc) 128 160) 255)        ;; The following 2 lines undo the 8-bit display that we set up
1688        (aset standard-display-table 146 nil))        ;; in standard-display-european-internal, which see.  This is in
1689          ;; case the user has used standard-display-european earlier in
1690          ;; this session.  (The MS-DOS port doesn't use that setup, so it
1691          ;; doesn't need to undo it.)
1692          (when standard-display-table
1693            (dotimes (i 128)
1694              (aset standard-display-table (+ i 128) nil))))
1695      (or (eq window-system 'pc)      (or (eq window-system 'pc)
1696        (set-terminal-coding-system coding))))          (set-terminal-coding-system coding))))
1697    
1698  (defun set-language-environment (language-name)  (defun set-language-environment (language-name)
1699    "Set up multi-lingual environment for using LANGUAGE-NAME.    "Set up multi-lingual environment for using LANGUAGE-NAME.
# Line 1681  specifies the character set for the majo Line 1708  specifies the character set for the majo
1708        (if (symbolp language-name)        (if (symbolp language-name)
1709            (setq language-name (symbol-name language-name)))            (setq language-name (symbol-name language-name)))
1710      (setq language-name "English"))      (setq language-name "English"))
1711    (or (assoc-ignore-case language-name language-info-alist)    (let ((slot (assoc-ignore-case language-name language-info-alist)))
1712        (unless slot
1713        (error "Language environment not defined: %S" language-name))        (error "Language environment not defined: %S" language-name))
1714        (setq language-name (car slot)))
1715    (if current-language-environment    (if current-language-environment
1716        (let ((func (get-language-info current-language-environment        (let ((func (get-language-info current-language-environment
1717                                       'exit-function)))                                       'exit-function)))
# Line 1771  specifies the character set for the majo Line 1800  specifies the character set for the majo
1800          (aset standard-display-table 160 [32])          (aset standard-display-table 160 [32])
1801          ;; With luck, non-Latin-1 fonts are more recent and so don't          ;; With luck, non-Latin-1 fonts are more recent and so don't
1802          ;; have this bug.          ;; have this bug.
1803          (aset standard-display-table 2208 [32]) ; Latin-1 NBSP          (aset standard-display-table (make-char 'latin-iso8859-1 160) [32])
1804          ;; Most Windows programs send out apostrophes as \222.  Most X fonts          ;; Most Windows programs send out apostrophes as \222.  Most X fonts
1805          ;; don't contain a character at that position.  Map it to the ASCII          ;; don't contain a character at that position.  Map it to the ASCII
1806          ;; apostrophe.  [This is actually RIGHT SINGLE QUOTATION MARK,          ;; apostrophe.  [This is actually RIGHT SINGLE QUOTATION MARK,
# Line 1779  specifies the character set for the majo Line 1808  specifies the character set for the majo
1808          ;; fonts probably have the appropriate glyph at this position,          ;; fonts probably have the appropriate glyph at this position,
1809          ;; so they could use standard-display-8bit.  It's better to use a          ;; so they could use standard-display-8bit.  It's better to use a
1810          ;; proper windows-1252 coding system.  --fx]          ;; proper windows-1252 coding system.  --fx]
1811          (aset standard-display-table 146 [39]))))          (aset standard-display-table 146 [39])
1812            ;; XFree86 4 has changed most of the fonts from their designed
1813            ;; versions such that `' no longer appears as balanced quotes.
1814            ;; Assume it has iso10646 fonts installed, so we can display
1815            ;; balanced quotes.
1816            (when (and (eq window-system 'x)
1817                       (string= "The XFree86 Project, Inc" (x-server-vendor))
1818                       (> (aref (number-to-string (nth 2 (x-server-version))) 0)
1819                          ?3))
1820              (aset standard-display-table ?' [?$,1ry(B])
1821              (aset standard-display-table ?` [?$,1rx(B])
1822              ;; The fonts don't have the relevant bug.
1823              (aset standard-display-table 160 nil)
1824              (aset standard-display-table (make-char 'latin-iso8859-1 160)
1825                    nil)))))
1826    
1827  (defun set-language-environment-coding-systems (language-name  (defun set-language-environment-coding-systems (language-name
1828                                                  &optional eol-type)                                                  &optional eol-type)
# Line 1838  of `buffer-file-coding-system' set by th Line 1881  of `buffer-file-coding-system' set by th
1881        (error "No documentation for the specified language"))        (error "No documentation for the specified language"))
1882    (if (symbolp language-name)    (if (symbolp language-name)
1883        (setq language-name (symbol-name language-name)))        (setq language-name (symbol-name language-name)))
1884      (dolist (feature (get-language-info language-name 'features))
1885        (require feature))
1886    (let ((doc (get-language-info language-name 'documentation))    (let ((doc (get-language-info language-name 'documentation))
1887          pos)          pos)
1888      (help-setup-xref (list #'describe-language-environment language-name)      (help-setup-xref (list #'describe-language-environment language-name)
# Line 2124  If the language name is nil, there is no Line 2169  If the language name is nil, there is no
2169       (".*8859[-_]?9\\>" . "Latin-5")       (".*8859[-_]?9\\>" . "Latin-5")
2170       (".*8859[-_]?14\\>" . "Latin-8")       (".*8859[-_]?14\\>" . "Latin-8")
2171       (".*8859[-_]?15\\>" . "Latin-9")       (".*8859[-_]?15\\>" . "Latin-9")
2172       (".*utf\\(-?8\\)\\>" . "UTF-8")       (".*utf-?8\\>" . "UTF-8")
2173       ;; utf-8@euro exists, so put this last.  (@euro really specifies       ;; utf-8@euro exists, so put this last.  (@euro really specifies
2174       ;; the currency, rather than the charset.)       ;; the currency, rather than the charset.)
2175       (".*@euro\\>" . "Latin-9")))       (".*@euro\\>" . "Latin-9")))
# Line 2271  See also `locale-charset-language-names' Line 2316  See also `locale-charset-language-names'
2316            (setq locale-coding-system coding-system))))            (setq locale-coding-system coding-system))))
2317    
2318      ;; Default to A4 paper if we're not in a C, POSIX or US locale.      ;; Default to A4 paper if we're not in a C, POSIX or US locale.
2319      ;; (See comments in Flanginfo.)      ;; (See comments in Flocale_info.)
2320      (let ((locale locale)      (let ((locale locale)
2321            (paper (langinfo 'paper)))            (paper (locale-info 'paper)))
2322        (if paper        (if paper
2323            ;; This will always be null at the time of writing.            ;; This will always be null at the time of writing.
2324            (cond            (cond
# Line 2358  It can be retrieved with `(get-char-code Line 2403  It can be retrieved with `(get-char-code
2403     (if (and coding-system (eq (coding-system-type coding-system) 2))     (if (and coding-system (eq (coding-system-type coding-system) 2))
2404         ;; Try to get a pretty description for ISO 2022 escape sequences.         ;; Try to get a pretty description for ISO 2022 escape sequences.
2405         (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))         (function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
2406                                   (format "%02X" x))))                                   (format "0x%02X" x))))
2407       (function (lambda (x) (format "0x%02X" x))))       (function (lambda (x) (format "0x%02X" x))))
2408     str " "))     str " "))
2409    
# Line 2394  If CODING-SYSTEM can't safely encode CHA Line 2439  If CODING-SYSTEM can't safely encode CHA
2439        (substring enc2 0 i2))))        (substring enc2 0 i2))))
2440    
2441    
2442    ;;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
2443  ;;; mule-cmds.el ends here  ;;; mule-cmds.el ends here

Legend:
Removed from v.1.194.2.1  
changed lines
  Added in v.1.194.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26