/[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.185.2.12 by handa, Thu Aug 15 02:27:11 2002 UTC revision 1.185.2.13 by fx, Sun Sep 8 19:48:33 2002 UTC
# Line 7  Line 7 
7  ;;   National Institute of Advanced Industrial Science and Technology (AIST)  ;;   National Institute of Advanced Industrial Science and Technology (AIST)
8  ;;   Registration Number H13PRO009  ;;   Registration Number H13PRO009
9    
10  ;; Keywords: mule, multilingual  ;; Keywords: mule, i18n
11    
12  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
13    
# Line 276  wrong, use this command again to toggle Line 276  wrong, use this command again to toggle
276                 (not (eq cmd 'universal-argument-other-key)))                 (not (eq cmd 'universal-argument-other-key)))
277          (let ((current-prefix-arg prefix-arg)          (let ((current-prefix-arg prefix-arg)
278                ;; Have to bind `last-command-char' here so that                ;; Have to bind `last-command-char' here so that
279                ;; `digit-argument', for isntance, can compute the                ;; `digit-argument', for instance, can compute the
280                ;; prefix arg.                ;; prefix arg.
281                (last-command-char (aref keyseq 0)))                (last-command-char (aref keyseq 0)))
282            (call-interactively cmd)))            (call-interactively cmd)))
283    
284        ;; This is the final call to `univeral-argument-other-key', which        ;; This is the final call to `universal-argument-other-key', which
285        ;; set's the final `prefix-arg.        ;; set's the final `prefix-arg.
286        (let ((current-prefix-arg prefix-arg))        (let ((current-prefix-arg prefix-arg))
287          (call-interactively cmd))          (call-interactively cmd))
# Line 435  If STRING contains no multibyte characte Line 435  If STRING contains no multibyte characte
435  element `undecided'."  element `undecided'."
436    (find-coding-systems-region string nil))    (find-coding-systems-region string nil))
437    
 ;; Fixme: re-write  
438  (defun find-coding-systems-for-charsets (charsets)  (defun find-coding-systems-for-charsets (charsets)
439    "Return a list of proper coding systems to encode characters of CHARSETS.    "Return a list of proper coding systems to encode characters of CHARSETS.
440  CHARSETS is a list of character sets."  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))
450    (cond ((or (null charsets)    (cond ((or (null charsets)
451               (and (= (length charsets) 1)               (and (= (length charsets) 1)
452                    (eq 'ascii (car charsets))))                    (eq 'ascii (car charsets))))
453           '(undecided))           '(undecided))
454          ((or (memq 'eight-bit-control charsets)          ((or (memq 'eight-bit-control charsets)
455               (memq 'eight-bit-graphic charsets))               (memq 'eight-bit-graphic charsets))
456           '(raw-text emacs-mule))           '(raw-text utf-8-emacs))
457          (t          (t
458           (let ((codings t)           (let (codings)
459                 charset l ll)             (dolist (cs (coding-system-list t))
460             (while (and codings charsets)               (let ((cs-charsets (coding-system-get cs :charset-list))
461               (setq charset (car charsets) charsets (cdr charsets))                     (charsets charsets))
462               (unless (eq charset 'ascii)                 (if (coding-system-get cs :ascii-compatible-p)
463                 (setq l (aref char-coding-system-table (make-char charset)))                     (add-to-list 'cs-charsets 'ascii))
464                 (if (eq codings t)                 (if (catch 'ok
465                     (setq codings l)                       (when cs-charsets
466                   (let ((ll nil))                         (while charsets
467                     (while codings                           (unless (memq (pop charsets) cs-charsets)
468                       (if (memq (car codings) l)                             (throw 'ok nil)))
469                           (setq ll (cons (car codings) ll)))                         t))
470                       (setq codings (cdr codings)))                     (push cs codings))))
471                     (setq codings ll)))))             (nreverse codings)))))
            (append codings  
                    (char-table-extra-slot char-coding-system-table 0))))))  
472    
473  ;; Fixme: is this doing the right thing now, at least with eight-bit?  ;; Fixme: is this doing the right thing now, at least with eight-bit?
474  (defun find-multibyte-characters (from to &optional maxcount excludes)  (defun find-multibyte-characters (from to &optional maxcount excludes)
# Line 473  The return value is an alist of the foll Line 479  The return value is an alist of the foll
479  where  where
480    CHARSET is a character set,    CHARSET is a character set,
481    COUNT is a number of characters,    COUNT is a number of characters,
482    CHARs are found characters of the character set.    CHARs are the characters found from the character set.
483  Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.  Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
484  Optional 4th arg EXCLUDE is a list of character sets to be ignored."  Optional 4th arg EXCLUDE is a list of character sets to be ignored."
485    (let ((chars nil)    (let ((chars nil)
# Line 766  is nil. Line 772  is nil.
772                          but as non-ASCII characters in this language                          but as non-ASCII characters in this language
773                          environment.")                          environment.")
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    
842  (defun get-language-info (lang-env key)  (defun get-language-info (lang-env key)
843    "Return information listed under KEY for language environment LANG-ENV.    "Return information listed under KEY for language environment LANG-ENV.
844  KEY is a symbol denoting the kind of information.  KEY is a symbol denoting the kind of information.
# Line 935  If nil, that means no input method is ac Line 1008  If nil, that means no input method is ac
1008    "*Default input method for multilingual text (a string).    "*Default input method for multilingual text (a string).
1009  This is the input method activated automatically by the command  This is the input method activated automatically by the command
1010  `toggle-input-method' (\\[toggle-input-method])."  `toggle-input-method' (\\[toggle-input-method])."
1011      :link  '(custom-manual "(emacs)Input Methods")
1012    :group 'mule    :group 'mule
1013    :type '(choice (const nil) string)    :type '(choice (const nil) string)
1014    :set-after '(current-language-environment))    :set-after '(current-language-environment))
# Line 1232  See also the variable `input-method-verb Line 1306  See also the variable `input-method-verb
1306    :type 'boolean    :type 'boolean
1307    :group 'mule)    :group 'mule)
1308    
1309  (defvar input-method-activate-hook nil  (defcustom input-method-activate-hook nil
1310    "Normal hook run just after an input method is activated.    "Normal hook run just after an input method is activated.
1311    
1312  The variable `current-input-method' keeps the input method name  The variable `current-input-method' keeps the input method name
1313  just activated.")  just activated."
1314      :type 'hook
1315      :group 'mule)
1316    
1317  (defvar input-method-inactivate-hook nil  (defcustom input-method-inactivate-hook nil
1318    "Normal hook run just after an input method is inactivated.    "Normal hook run just after an input method is inactivated.
1319    
1320  The variable `current-input-method' still keeps the input method name  The variable `current-input-method' still keeps the input method name
1321  just inactivated.")  just inactivated."
1322      :type 'hook
1323      :group 'mule)
1324    
1325  (defvar input-method-after-insert-chunk-hook nil  (defcustom input-method-after-insert-chunk-hook nil
1326    "Normal hook run just after an input method insert some chunk of text.")    "Normal hook run just after an input method inserts some chunk of text."
1327      :type 'hook
1328      :group 'mule)
1329    
1330  (defvar input-method-exit-on-first-char nil  (defvar input-method-exit-on-first-char nil
1331    "This flag controls when an input method returns.    "This flag controls when an input method returns.
# Line 1254  that it may find a different translation Line 1334  that it may find a different translation
1334  But, it this flag is non-nil, the input method returns as soon as  But, it this flag is non-nil, the input method returns as soon as
1335  the current key sequence gets long enough to have some valid translation.")  the current key sequence gets long enough to have some valid translation.")
1336    
1337  (defvar input-method-use-echo-area nil  (defcustom input-method-use-echo-area nil
1338    "This flag controls how an input method shows an intermediate key sequence.    "This flag controls how an input method shows an intermediate key sequence.
1339  Usually, the input method inserts the intermediate key sequence,  Usually, the input method inserts the intermediate key sequence,
1340  or candidate translations corresponding to the sequence,  or candidate translations corresponding to the sequence,
1341  at point in the current buffer.  at point in the current buffer.
1342  But, if this flag is non-nil, it displays them in echo area instead.")  But, if this flag is non-nil, it displays them in echo area instead."
1343      :type 'hook
1344      :group 'mule)
1345    
1346  (defvar input-method-exit-on-invalid-key nil  (defvar input-method-exit-on-invalid-key nil
1347    "This flag controls the behaviour of an input method on invalid key input.    "This flag controls the behaviour of an input method on invalid key input.
# Line 1269  input method temporarily.  After that ke Line 1351  input method temporarily.  After that ke
1351  But, if this flag is non-nil, the input method is never back on.")  But, if this flag is non-nil, the input method is never back on.")
1352    
1353    
1354  (defvar set-language-environment-hook nil  (defcustom set-language-environment-hook nil
1355    "Normal hook run after some language environment is set.    "Normal hook run after some language environment is set.
1356    
1357  When you set some hook function here, that effect usually should not  When you set some hook function here, that effect usually should not
1358  be inherited to another language environment.  So, you had better set  be inherited to another language environment.  So, you had better set
1359  another function in `exit-language-environment-hook' (which see) to  another function in `exit-language-environment-hook' (which see) to
1360  cancel the effect.")  cancel the effect."
1361      :type 'hook
1362      :group 'mule)
1363    
1364  (defvar exit-language-environment-hook nil  (defcustom exit-language-environment-hook nil
1365    "Normal hook run after exiting from some language environment.    "Normal hook run after exiting from some language environment.
1366  When this hook is run, the variable `current-language-environment'  When this hook is run, the variable `current-language-environment'
1367  is still bound to the language environment being exited.  is still bound to the language environment being exited.
1368    
1369  This hook is mainly used for canceling the effect of  This hook is mainly used for canceling the effect of
1370  `set-language-environment-hook' (which-see).")  `set-language-environment-hook' (which-see)."
1371      :type 'hook
1372      :group 'mule)
1373    
1374  (put 'setup-specified-language-environment 'apropos-inhibit t)  (put 'setup-specified-language-environment 'apropos-inhibit t)
1375    
# Line 1399  specifies the character set for the majo Line 1485  specifies the character set for the majo
1485                             default-buffer-file-coding-system)))                             default-buffer-file-coding-system)))
1486      (reset-language-environment)      (reset-language-environment)
1487    
1488      ;; The fetaures might set up coding systems.      ;; The features might set up coding systems.
1489      (let ((required-features (get-language-info language-name 'features)))      (let ((required-features (get-language-info language-name 'features)))
1490        (while required-features        (while required-features
1491          (require (car required-features))          (require (car required-features))
# Line 1415  specifies the character set for the majo Line 1501  specifies the character set for the majo
1501                  (cons input-method                  (cons input-method
1502                        (delete input-method input-method-history))))))                        (delete input-method input-method-history))))))
1503    
1504      ;; Fixme: default from the environment coding system where that's
1505      ;; charset-based.
1506    (apply 'set-charset-priority  (get-language-info language-name 'charset))    (apply 'set-charset-priority  (get-language-info language-name 'charset))
1507    
1508    ;; Note: For DOS, we assumed that the charset cpXXX is already    ;; Note: For DOS, we assumed that the charset cpXXX is already
# Line 1442  specifies the character set for the majo Line 1530  specifies the character set for the majo
1530              (modify-syntax-entry ch " " syntax-table)              (modify-syntax-entry ch " " syntax-table)
1531              (aset case-table ch ch)              (aset case-table ch ch)
1532              (setq ch (1+ ch)))              (setq ch (1+ ch)))
1533            (set-char-table-extra-slot case-table 0 nil)          (set-char-table-extra-slot case-table 0 nil)
1534            (set-char-table-extra-slot case-table 1 nil)          (set-char-table-extra-slot case-table 1 nil)
1535            (set-char-table-extra-slot case-table 2 nil))          (set-char-table-extra-slot case-table 2 nil))
1536          (set-standard-case-table (standard-case-table))          (set-standard-case-table (standard-case-table))
1537          (let ((list (buffer-list)))          (let ((list (buffer-list)))
1538            (while list            (while list
# Line 1491  specifies the character set for the majo Line 1579  specifies the character set for the majo
1579    "Do various coding system setups for language environment LANGUAGE-NAME.    "Do various coding system setups for language environment LANGUAGE-NAME.
1580    
1581  The optional arg EOL-TYPE specifies the eol-type of the default value  The optional arg EOL-TYPE specifies the eol-type of the default value
1582  of buffer-file-coding-system set by this function."  of `buffer-file-coding-system' set by this function."
1583    (let* ((priority (get-language-info language-name 'coding-priority))    (let* ((priority (get-language-info language-name 'coding-priority))
1584           (default-coding (car priority)))           (default-coding (car priority)))
1585      (when priority      (when priority

Legend:
Removed from v.1.185.2.12  
changed lines
  Added in v.1.185.2.13

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