diff options
| author | Dave Love | 2002-09-08 19:49:54 +0000 |
|---|---|---|
| committer | Dave Love | 2002-09-08 19:49:54 +0000 |
| commit | 1f547b9223586413f4e96b5bf77ad23472e8cdea (patch) | |
| tree | e706242cb0747ca930d4e968f69f266d17c49cba | |
| parent | 428471c0fda7254f19799e06e291740147d49b51 (diff) | |
| download | emacs-1f547b9223586413f4e96b5bf77ad23472e8cdea.tar.gz emacs-1f547b9223586413f4e96b5bf77ad23472e8cdea.zip | |
(language-info-custom-alist): New.
(input-method-activate-hook, input-method-inactivate-hook)
(input-method-after-insert-chunk-hook)
(input-method-use-echo-area, set-language-environment-hook)
(exit-language-environment-hook): Customize.
(find-coding-systems-for-charsets): Rewritten.
(default-input-method): Add :link.
| -rw-r--r-- | lisp/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/international/mule-cmds.el | 168 |
2 files changed, 142 insertions, 40 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1252a054f01..cae85b754a6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,19 @@ | |||
| 1 | 2002-09-08 Dave Love <fx@gnu.org> | 1 | 2002-09-08 Dave Love <fx@gnu.org> |
| 2 | 2 | ||
| 3 | * international/mule-conf.el (emacs-mule, iso-2022-7bit) | ||
| 4 | (iso-2022-7bit-ss2, iso-2022-7bit-lock, iso-2022-8bit-ss2) | ||
| 5 | (compound-text, ctext-no-compositions): Remove :charset-list. | ||
| 6 | |||
| 7 | * international/mule-cmds.el (language-info-custom-alist): New. | ||
| 8 | (input-method-activate-hook, input-method-inactivate-hook) | ||
| 9 | (input-method-after-insert-chunk-hook) | ||
| 10 | (input-method-use-echo-area, set-language-environment-hook) | ||
| 11 | (exit-language-environment-hook): Customize. | ||
| 12 | (find-coding-systems-for-charsets): Rewritten. | ||
| 13 | (default-input-method): Add :link. | ||
| 14 | |||
| 15 | 2002-09-08 Dave Love <fx@gnu.org> | ||
| 16 | |||
| 3 | * international/mule-conf.el (eight-bit): Add :docstring, | 17 | * international/mule-conf.el (eight-bit): Add :docstring, |
| 4 | :short-name properties. | 18 | :short-name properties. |
| 5 | (cp851): Doc fix. | 19 | (cp851): Doc fix. |
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 3172e11115c..f9a1cf45748 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el | |||
| @@ -7,7 +7,7 @@ | |||
| 7 | ;; National Institute of Advanced Industrial Science and Technology (AIST) | 7 | ;; National Institute of Advanced Industrial Science and Technology (AIST) |
| 8 | ;; Registration Number H13PRO009 | 8 | ;; Registration Number H13PRO009 |
| 9 | 9 | ||
| 10 | ;; Keywords: mule, multilingual | 10 | ;; Keywords: mule, i18n |
| 11 | 11 | ||
| 12 | ;; This file is part of GNU Emacs. | 12 | ;; This file is part of GNU Emacs. |
| 13 | 13 | ||
| @@ -276,12 +276,12 @@ wrong, use this command again to toggle back to the right mode." | |||
| 276 | (not (eq cmd 'universal-argument-other-key))) | 276 | (not (eq cmd 'universal-argument-other-key))) |
| 277 | (let ((current-prefix-arg prefix-arg) | 277 | (let ((current-prefix-arg prefix-arg) |
| 278 | ;; Have to bind `last-command-char' here so that | 278 | ;; Have to bind `last-command-char' here so that |
| 279 | ;; `digit-argument', for isntance, can compute the | 279 | ;; `digit-argument', for instance, can compute the |
| 280 | ;; prefix arg. | 280 | ;; prefix arg. |
| 281 | (last-command-char (aref keyseq 0))) | 281 | (last-command-char (aref keyseq 0))) |
| 282 | (call-interactively cmd))) | 282 | (call-interactively cmd))) |
| 283 | 283 | ||
| 284 | ;; This is the final call to `univeral-argument-other-key', which | 284 | ;; This is the final call to `universal-argument-other-key', which |
| 285 | ;; set's the final `prefix-arg. | 285 | ;; set's the final `prefix-arg. |
| 286 | (let ((current-prefix-arg prefix-arg)) | 286 | (let ((current-prefix-arg prefix-arg)) |
| 287 | (call-interactively cmd)) | 287 | (call-interactively cmd)) |
| @@ -435,34 +435,40 @@ If STRING contains no multibyte characters, return a list of a single | |||
| 435 | element `undecided'." | 435 | element `undecided'." |
| 436 | (find-coding-systems-region string nil)) | 436 | (find-coding-systems-region string nil)) |
| 437 | 437 | ||
| 438 | ;; Fixme: re-write | ||
| 439 | (defun find-coding-systems-for-charsets (charsets) | 438 | (defun find-coding-systems-for-charsets (charsets) |
| 440 | "Return a list of proper coding systems to encode characters of CHARSETS. | 439 | "Return a list of proper coding systems to encode characters of CHARSETS. |
| 441 | CHARSETS is a list of character sets." | 440 | CHARSETS is a list of character sets. |
| 441 | |||
| 442 | This only finds coding systems of type `charset', whose | ||
| 443 | `:charset-list' property includes all of CHARSETS (plus `ascii' for | ||
| 444 | ascii-compatible coding systems). It was used in older versions of | ||
| 445 | Emacs, but is unlikely to be what you really want now." | ||
| 446 | ;; Deal with aliases. | ||
| 447 | (setq charsets (mapcar (lambda (c) | ||
| 448 | (get-charset-property c :name)) | ||
| 449 | charsets)) | ||
| 442 | (cond ((or (null charsets) | 450 | (cond ((or (null charsets) |
| 443 | (and (= (length charsets) 1) | 451 | (and (= (length charsets) 1) |
| 444 | (eq 'ascii (car charsets)))) | 452 | (eq 'ascii (car charsets)))) |
| 445 | '(undecided)) | 453 | '(undecided)) |
| 446 | ((or (memq 'eight-bit-control charsets) | 454 | ((or (memq 'eight-bit-control charsets) |
| 447 | (memq 'eight-bit-graphic charsets)) | 455 | (memq 'eight-bit-graphic charsets)) |
| 448 | '(raw-text emacs-mule)) | 456 | '(raw-text utf-8-emacs)) |
| 449 | (t | 457 | (t |
| 450 | (let ((codings t) | 458 | (let (codings) |
| 451 | charset l ll) | 459 | (dolist (cs (coding-system-list t)) |
| 452 | (while (and codings charsets) | 460 | (let ((cs-charsets (coding-system-get cs :charset-list)) |
| 453 | (setq charset (car charsets) charsets (cdr charsets)) | 461 | (charsets charsets)) |
| 454 | (unless (eq charset 'ascii) | 462 | (if (coding-system-get cs :ascii-compatible-p) |
| 455 | (setq l (aref char-coding-system-table (make-char charset))) | 463 | (add-to-list 'cs-charsets 'ascii)) |
| 456 | (if (eq codings t) | 464 | (if (catch 'ok |
| 457 | (setq codings l) | 465 | (when cs-charsets |
| 458 | (let ((ll nil)) | 466 | (while charsets |
| 459 | (while codings | 467 | (unless (memq (pop charsets) cs-charsets) |
| 460 | (if (memq (car codings) l) | 468 | (throw 'ok nil))) |
| 461 | (setq ll (cons (car codings) ll))) | 469 | t)) |
| 462 | (setq codings (cdr codings))) | 470 | (push cs codings)))) |
| 463 | (setq codings ll))))) | 471 | (nreverse codings))))) |
| 464 | (append codings | ||
| 465 | (char-table-extra-slot char-coding-system-table 0)))))) | ||
| 466 | 472 | ||
| 467 | ;; Fixme: is this doing the right thing now, at least with eight-bit? | 473 | ;; Fixme: is this doing the right thing now, at least with eight-bit? |
| 468 | (defun find-multibyte-characters (from to &optional maxcount excludes) | 474 | (defun find-multibyte-characters (from to &optional maxcount excludes) |
| @@ -473,7 +479,7 @@ The return value is an alist of the following format: | |||
| 473 | where | 479 | where |
| 474 | CHARSET is a character set, | 480 | CHARSET is a character set, |
| 475 | COUNT is a number of characters, | 481 | COUNT is a number of characters, |
| 476 | CHARs are found characters of the character set. | 482 | CHARs are the characters found from the character set. |
| 477 | Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list. | 483 | Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list. |
| 478 | Optional 4th arg EXCLUDE is a list of character sets to be ignored." | 484 | Optional 4th arg EXCLUDE is a list of character sets to be ignored." |
| 479 | (let ((chars nil) | 485 | (let ((chars nil) |
| @@ -766,6 +772,73 @@ is nil. | |||
| 766 | but as non-ASCII characters in this language | 772 | but as non-ASCII characters in this language |
| 767 | environment.") | 773 | environment.") |
| 768 | 774 | ||
| 775 | (defcustom language-info-custom-alist nil | ||
| 776 | "Customizations of language environment parameters. | ||
| 777 | Value is an alist with elements like those of `language-info-alist'. | ||
| 778 | These are used to set values in `language-info-alist' which replace | ||
| 779 | the defaults. A typical use is replacing the default input method for | ||
| 780 | the environment. Use \\[describe-language-environment] to find the environment's | ||
| 781 | settings. | ||
| 782 | |||
| 783 | Setting this variable directly does not take effect. See | ||
| 784 | `set-language-info-alist' for use in programs." | ||
| 785 | :group 'mule | ||
| 786 | :version "22.1" | ||
| 787 | :set (lambda (s v) | ||
| 788 | (custom-set-default s v) | ||
| 789 | ;; modify language-info-alist | ||
| 790 | (dolist (elt v) | ||
| 791 | (set-language-info-alist (car elt) (cdr elt))) | ||
| 792 | ;; re-set the environment in case its parameters changed | ||
| 793 | (set-language-environment current-language-environment)) | ||
| 794 | :type '(alist | ||
| 795 | :key-type | ||
| 796 | (string :tag "Language environment" | ||
| 797 | :complete-function | ||
| 798 | (lambda () | ||
| 799 | (interactive) | ||
| 800 | (let* ((prefix (buffer-substring-no-properties | ||
| 801 | (widget-field-start widget) (point))) | ||
| 802 | (completion-ignore-case t) | ||
| 803 | (completion (try-completion prefix | ||
| 804 | language-info-alist))) | ||
| 805 | (cond ((eq completion t) | ||
| 806 | (delete-region (widget-field-start widget) | ||
| 807 | (widget-field-end widget)) | ||
| 808 | (insert-and-inherit | ||
| 809 | (car (assoc-ignore-case prefix | ||
| 810 | language-info-alist))) | ||
| 811 | (message "Only match")) | ||
| 812 | ((null completion) | ||
| 813 | (error "No match")) | ||
| 814 | ((not (eq t (compare-strings prefix nil nil | ||
| 815 | completion nil nil | ||
| 816 | t))) | ||
| 817 | (delete-region (widget-field-start widget) | ||
| 818 | (widget-field-end widget)) | ||
| 819 | (insert-and-inherit completion)) | ||
| 820 | (t | ||
| 821 | (message "Making completion list...") | ||
| 822 | (with-output-to-temp-buffer "*Completions*" | ||
| 823 | (display-completion-list | ||
| 824 | (all-completions prefix language-info-alist | ||
| 825 | nil))) | ||
| 826 | (message "Making completion list...done")))))) | ||
| 827 | :value-type | ||
| 828 | (alist :key-type symbol | ||
| 829 | :options ((documentation string) | ||
| 830 | (charset (repeat symbol)) | ||
| 831 | (sample-text string) | ||
| 832 | (setup-function function) | ||
| 833 | (exit-function function) | ||
| 834 | (coding-system (repeat coding-system)) | ||
| 835 | (coding-priority (repeat coding-system)) | ||
| 836 | (nonascii-translation symbol) | ||
| 837 | (input-method string) | ||
| 838 | (features (repeat symbol)) | ||
| 839 | (unibyte-display coding-system) | ||
| 840 | (unibyte-syntax string))))) | ||
| 841 | |||
| 769 | (defun get-language-info (lang-env key) | 842 | (defun get-language-info (lang-env key) |
| 770 | "Return information listed under KEY for language environment LANG-ENV. | 843 | "Return information listed under KEY for language environment LANG-ENV. |
| 771 | KEY is a symbol denoting the kind of information. | 844 | KEY is a symbol denoting the kind of information. |
| @@ -935,6 +1008,7 @@ If nil, that means no input method is activated now.") | |||
| 935 | "*Default input method for multilingual text (a string). | 1008 | "*Default input method for multilingual text (a string). |
| 936 | This is the input method activated automatically by the command | 1009 | This is the input method activated automatically by the command |
| 937 | `toggle-input-method' (\\[toggle-input-method])." | 1010 | `toggle-input-method' (\\[toggle-input-method])." |
| 1011 | :link '(custom-manual "(emacs)Input Methods") | ||
| 938 | :group 'mule | 1012 | :group 'mule |
| 939 | :type '(choice (const nil) string) | 1013 | :type '(choice (const nil) string) |
| 940 | :set-after '(current-language-environment)) | 1014 | :set-after '(current-language-environment)) |
| @@ -1232,20 +1306,26 @@ See also the variable `input-method-verbose-flag'." | |||
| 1232 | :type 'boolean | 1306 | :type 'boolean |
| 1233 | :group 'mule) | 1307 | :group 'mule) |
| 1234 | 1308 | ||
| 1235 | (defvar input-method-activate-hook nil | 1309 | (defcustom input-method-activate-hook nil |
| 1236 | "Normal hook run just after an input method is activated. | 1310 | "Normal hook run just after an input method is activated. |
| 1237 | 1311 | ||
| 1238 | The variable `current-input-method' keeps the input method name | 1312 | The variable `current-input-method' keeps the input method name |
| 1239 | just activated.") | 1313 | just activated." |
| 1314 | :type 'hook | ||
| 1315 | :group 'mule) | ||
| 1240 | 1316 | ||
| 1241 | (defvar input-method-inactivate-hook nil | 1317 | (defcustom input-method-inactivate-hook nil |
| 1242 | "Normal hook run just after an input method is inactivated. | 1318 | "Normal hook run just after an input method is inactivated. |
| 1243 | 1319 | ||
| 1244 | The variable `current-input-method' still keeps the input method name | 1320 | The variable `current-input-method' still keeps the input method name |
| 1245 | just inactivated.") | 1321 | just inactivated." |
| 1322 | :type 'hook | ||
| 1323 | :group 'mule) | ||
| 1246 | 1324 | ||
| 1247 | (defvar input-method-after-insert-chunk-hook nil | 1325 | (defcustom input-method-after-insert-chunk-hook nil |
| 1248 | "Normal hook run just after an input method insert some chunk of text.") | 1326 | "Normal hook run just after an input method inserts some chunk of text." |
| 1327 | :type 'hook | ||
| 1328 | :group 'mule) | ||
| 1249 | 1329 | ||
| 1250 | (defvar input-method-exit-on-first-char nil | 1330 | (defvar input-method-exit-on-first-char nil |
| 1251 | "This flag controls when an input method returns. | 1331 | "This flag controls when an input method returns. |
| @@ -1254,12 +1334,14 @@ that it may find a different translation if a user types another key. | |||
| 1254 | But, it this flag is non-nil, the input method returns as soon as | 1334 | But, it this flag is non-nil, the input method returns as soon as |
| 1255 | the current key sequence gets long enough to have some valid translation.") | 1335 | the current key sequence gets long enough to have some valid translation.") |
| 1256 | 1336 | ||
| 1257 | (defvar input-method-use-echo-area nil | 1337 | (defcustom input-method-use-echo-area nil |
| 1258 | "This flag controls how an input method shows an intermediate key sequence. | 1338 | "This flag controls how an input method shows an intermediate key sequence. |
| 1259 | Usually, the input method inserts the intermediate key sequence, | 1339 | Usually, the input method inserts the intermediate key sequence, |
| 1260 | or candidate translations corresponding to the sequence, | 1340 | or candidate translations corresponding to the sequence, |
| 1261 | at point in the current buffer. | 1341 | at point in the current buffer. |
| 1262 | But, if this flag is non-nil, it displays them in echo area instead.") | 1342 | But, if this flag is non-nil, it displays them in echo area instead." |
| 1343 | :type 'hook | ||
| 1344 | :group 'mule) | ||
| 1263 | 1345 | ||
| 1264 | (defvar input-method-exit-on-invalid-key nil | 1346 | (defvar input-method-exit-on-invalid-key nil |
| 1265 | "This flag controls the behaviour of an input method on invalid key input. | 1347 | "This flag controls the behaviour of an input method on invalid key input. |
| @@ -1269,21 +1351,25 @@ input method temporarily. After that key, the input method is re-enabled. | |||
| 1269 | But, if this flag is non-nil, the input method is never back on.") | 1351 | But, if this flag is non-nil, the input method is never back on.") |
| 1270 | 1352 | ||
| 1271 | 1353 | ||
| 1272 | (defvar set-language-environment-hook nil | 1354 | (defcustom set-language-environment-hook nil |
| 1273 | "Normal hook run after some language environment is set. | 1355 | "Normal hook run after some language environment is set. |
| 1274 | 1356 | ||
| 1275 | When you set some hook function here, that effect usually should not | 1357 | When you set some hook function here, that effect usually should not |
| 1276 | be inherited to another language environment. So, you had better set | 1358 | be inherited to another language environment. So, you had better set |
| 1277 | another function in `exit-language-environment-hook' (which see) to | 1359 | another function in `exit-language-environment-hook' (which see) to |
| 1278 | cancel the effect.") | 1360 | cancel the effect." |
| 1361 | :type 'hook | ||
| 1362 | :group 'mule) | ||
| 1279 | 1363 | ||
| 1280 | (defvar exit-language-environment-hook nil | 1364 | (defcustom exit-language-environment-hook nil |
| 1281 | "Normal hook run after exiting from some language environment. | 1365 | "Normal hook run after exiting from some language environment. |
| 1282 | When this hook is run, the variable `current-language-environment' | 1366 | When this hook is run, the variable `current-language-environment' |
| 1283 | is still bound to the language environment being exited. | 1367 | is still bound to the language environment being exited. |
| 1284 | 1368 | ||
| 1285 | This hook is mainly used for canceling the effect of | 1369 | This hook is mainly used for canceling the effect of |
| 1286 | `set-language-environment-hook' (which-see).") | 1370 | `set-language-environment-hook' (which-see)." |
| 1371 | :type 'hook | ||
| 1372 | :group 'mule) | ||
| 1287 | 1373 | ||
| 1288 | (put 'setup-specified-language-environment 'apropos-inhibit t) | 1374 | (put 'setup-specified-language-environment 'apropos-inhibit t) |
| 1289 | 1375 | ||
| @@ -1399,7 +1485,7 @@ specifies the character set for the major languages of Western Europe." | |||
| 1399 | default-buffer-file-coding-system))) | 1485 | default-buffer-file-coding-system))) |
| 1400 | (reset-language-environment) | 1486 | (reset-language-environment) |
| 1401 | 1487 | ||
| 1402 | ;; The fetaures might set up coding systems. | 1488 | ;; The features might set up coding systems. |
| 1403 | (let ((required-features (get-language-info language-name 'features))) | 1489 | (let ((required-features (get-language-info language-name 'features))) |
| 1404 | (while required-features | 1490 | (while required-features |
| 1405 | (require (car required-features)) | 1491 | (require (car required-features)) |
| @@ -1415,6 +1501,8 @@ specifies the character set for the major languages of Western Europe." | |||
| 1415 | (cons input-method | 1501 | (cons input-method |
| 1416 | (delete input-method input-method-history)))))) | 1502 | (delete input-method input-method-history)))))) |
| 1417 | 1503 | ||
| 1504 | ;; Fixme: default from the environment coding system where that's | ||
| 1505 | ;; charset-based. | ||
| 1418 | (apply 'set-charset-priority (get-language-info language-name 'charset)) | 1506 | (apply 'set-charset-priority (get-language-info language-name 'charset)) |
| 1419 | 1507 | ||
| 1420 | ;; Note: For DOS, we assumed that the charset cpXXX is already | 1508 | ;; Note: For DOS, we assumed that the charset cpXXX is already |
| @@ -1442,9 +1530,9 @@ specifies the character set for the major languages of Western Europe." | |||
| 1442 | (modify-syntax-entry ch " " syntax-table) | 1530 | (modify-syntax-entry ch " " syntax-table) |
| 1443 | (aset case-table ch ch) | 1531 | (aset case-table ch ch) |
| 1444 | (setq ch (1+ ch))) | 1532 | (setq ch (1+ ch))) |
| 1445 | (set-char-table-extra-slot case-table 0 nil) | 1533 | (set-char-table-extra-slot case-table 0 nil) |
| 1446 | (set-char-table-extra-slot case-table 1 nil) | 1534 | (set-char-table-extra-slot case-table 1 nil) |
| 1447 | (set-char-table-extra-slot case-table 2 nil)) | 1535 | (set-char-table-extra-slot case-table 2 nil)) |
| 1448 | (set-standard-case-table (standard-case-table)) | 1536 | (set-standard-case-table (standard-case-table)) |
| 1449 | (let ((list (buffer-list))) | 1537 | (let ((list (buffer-list))) |
| 1450 | (while list | 1538 | (while list |
| @@ -1491,7 +1579,7 @@ specifies the character set for the major languages of Western Europe." | |||
| 1491 | "Do various coding system setups for language environment LANGUAGE-NAME. | 1579 | "Do various coding system setups for language environment LANGUAGE-NAME. |
| 1492 | 1580 | ||
| 1493 | The optional arg EOL-TYPE specifies the eol-type of the default value | 1581 | The optional arg EOL-TYPE specifies the eol-type of the default value |
| 1494 | of buffer-file-coding-system set by this function." | 1582 | of `buffer-file-coding-system' set by this function." |
| 1495 | (let* ((priority (get-language-info language-name 'coding-priority)) | 1583 | (let* ((priority (get-language-info language-name 'coding-priority)) |
| 1496 | (default-coding (car priority))) | 1584 | (default-coding (car priority))) |
| 1497 | (when priority | 1585 | (when priority |