diff options
Diffstat (limited to 'lisp/international/mule-cmds.el')
| -rw-r--r-- | lisp/international/mule-cmds.el | 130 |
1 files changed, 89 insertions, 41 deletions
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 5dc3de4422b..71e2653ffe9 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -679,18 +679,18 @@ DEFAULT is the coding system to use by default in the query." ;; ((CODING (POS . CHAR) (POS . CHAR) ...) ...) (if unsafe (setq unsafe - (mapcar #'(lambda (coding) - (cons coding - (if (stringp from) - (mapcar #'(lambda (pos) - (cons pos (aref from pos))) - (unencodable-char-position - 0 (length from) coding - 11 from)) - (mapcar #'(lambda (pos) - (cons pos (char-after pos))) - (unencodable-char-position - from to coding 11))))) + (mapcar (lambda (coding) + (cons coding + (if (stringp from) + (mapcar (lambda (pos) + (cons pos (aref from pos))) + (unencodable-char-position + 0 (length from) coding + 11 from)) + (mapcar (lambda (pos) + (cons pos (char-after pos))) + (unencodable-char-position + from to coding 11))))) unsafe))) (setq codings (sanitize-coding-system-list codings)) @@ -744,19 +744,19 @@ e.g., for sending an email message.\n ") (insert (format " %s cannot encode these:" (car coding))) (let ((i 0) (func1 - #'(lambda (bufname pos) - (when (buffer-live-p (get-buffer bufname)) - (pop-to-buffer bufname) - (goto-char pos)))) + (lambda (bufname pos) + (when (buffer-live-p (get-buffer bufname)) + (pop-to-buffer bufname) + (goto-char pos)))) (func2 - #'(lambda (bufname pos coding) - (when (buffer-live-p (get-buffer bufname)) - (pop-to-buffer bufname) - (if (< (point) pos) - (goto-char pos) - (forward-char 1) - (search-unencodable-char coding) - (forward-char -1)))))) + (lambda (bufname pos coding) + (when (buffer-live-p (get-buffer bufname)) + (pop-to-buffer bufname) + (if (< (point) pos) + (goto-char pos) + (forward-char 1) + (search-unencodable-char coding) + (forward-char -1)))))) (dolist (elt (cdr coding)) (insert " ") (if (stringp from) @@ -1524,7 +1524,7 @@ To deactivate it programmatically, use `deactivate-input-method'." (interactive (let* ((default (or (car input-method-history) default-input-method))) (list (read-input-method-name - (if default "Select input method (default %s): " "Select input method: ") + (format-prompt "Select input method" default) default t) t))) (activate-input-method input-method) @@ -1569,7 +1569,7 @@ which marks the variable `default-input-method' as set for Custom buffers." (if (or arg (not default)) (progn (read-input-method-name - (if default "Input method (default %s): " "Input method: " ) + (format-prompt "Input method" default) default t)) default)) (unless default-input-method @@ -1620,7 +1620,7 @@ If `default-transient-input-method' was not yet defined, prompt for it." "Describe input method INPUT-METHOD." (interactive (list (read-input-method-name - "Describe input method (default current choice): "))) + (format-prompt "Describe input method" current-input-method)))) (if (and input-method (symbolp input-method)) (setq input-method (symbol-name input-method))) (help-setup-xref (list #'describe-input-method @@ -1929,7 +1929,7 @@ runs the hook `exit-language-environment-hook'. After setting up the new language environment, it runs `set-language-environment-hook'." (interactive (list (read-language-name nil - "Set language environment (default English): "))) + (format-prompt "Set language environment" "English")))) (if language-name (if (symbolp language-name) (setq language-name (symbol-name language-name))) @@ -2144,7 +2144,7 @@ See `set-language-info-alist' for use in programs." (interactive (list (read-language-name 'documentation - "Describe language environment (default current choice): "))) + (format-prompt "Describe language environment" current-language-environment)))) (if (null language-name) (setq language-name current-language-environment)) (if (or (null language-name) @@ -2166,7 +2166,7 @@ See `set-language-info-alist' for use in programs." (let ((str (eval (get-language-info language-name 'sample-text)))) (if (stringp str) (insert "Sample text:\n " - (replace-regexp-in-string "\n" "\n " str) + (string-replace "\n" "\n " str) "\n\n"))) (error nil)) (let ((input-method (get-language-info language-name 'input-method)) @@ -2245,7 +2245,7 @@ See `set-language-info-alist' for use in programs." ;; LANGUAGE is a language code taken from ISO 639:1988 (E/F) ;; with additions from ISO 639/RA Newsletter No.1/1989; ;; see Internet RFC 2165 (1997-06) and - ;; http://www.evertype.com/standards/iso639/iso639-en.html + ;; https://www.evertype.com/standards/iso639/iso639-en.html ;; TERRITORY is a country code taken from ISO 3166 ;; http://www.din.de/gremien/nas/nabd/iso3166ma/codlstp1/en_listp1.html. ;; CODESET and MODIFIER are implementation-dependent. @@ -2963,18 +2963,22 @@ STR should be a unibyte string." str " ")) (defun encode-coding-char (char coding-system &optional charset) - "Encode CHAR by CODING-SYSTEM and return the resulting string. + "Encode CHAR by CODING-SYSTEM and return the resulting string of bytes. If CODING-SYSTEM can't safely encode CHAR, return nil. The 3rd optional argument CHARSET, if non-nil, is a charset preferred on encoding." (let* ((str1 (string char)) (str2 (string char char)) (found (find-coding-systems-string str1)) - enc1 enc2 i1 i2) - (if (eq (car-safe found) 'undecided) ;Aka (not (multibyte-string-p str1)) - ;; `char' is ASCII. + (bom-p (coding-system-get coding-system :bom)) + enc1 enc2 i0 i1 i2) + ;; If CHAR is ASCII and CODING-SYSTEM doesn't prepend a BOM, just + ;; encode CHAR. + (if (and (eq (car-safe found) 'undecided) + (null bom-p)) (encode-coding-string str1 coding-system) - (when (memq (coding-system-base coding-system) found) + (when (or (eq (car-safe found) 'undecided) + (memq (coding-system-base coding-system) found)) ;; We must find the encoded string of CHAR. But, just encoding ;; CHAR will put extra control sequences (usually to designate ;; ASCII charset) at the tail if type of CODING is ISO 2022. @@ -2995,7 +2999,19 @@ on encoding." ;; Now (substring enc1 i1) and (substring enc2 i2) are the same, ;; and they are the extra control sequences at the tail to ;; exclude. - (substring enc2 0 i2))))) + + ;; We also need to exclude the leading 2 or 3 bytes if they + ;; come from a BOM. + (setq i0 + (if bom-p + (cond + ((eq (coding-system-type coding-system) 'utf-8) + 3) + ((eq (coding-system-type coding-system) 'utf-16) + 2) + (t 0)) + 0)) + (substring enc2 i0 i2))))) ;; Backwards compatibility. These might be better with :init-value t, ;; but that breaks loadup. @@ -3047,7 +3063,7 @@ on encoding." (#x1D000 . #x1FFFF) ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused (#xE0000 . #xE01FF))) - (gc-cons-threshold 10000000) + (gc-cons-threshold (max gc-cons-threshold 10000000)) (names (make-hash-table :size 42943 :test #'equal))) (dolist (range ranges) (let ((c (car range)) @@ -3077,12 +3093,24 @@ on encoding." (puthash "BELL (BEL)" ?\a names) (setq ucs-names names)))) +(defun mule--ucs-names-sort-by-code (names) + (let ((codes-and-names + (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))) + (mapcar #'cdr (sort codes-and-names #'car-less-than-car)))) + (defun mule--ucs-names-affixation (names) (mapcar (lambda (name) (let ((char (gethash name ucs-names))) - (list name (concat (if char (format "%c" char) " ") "\t") ""))) + (list name (concat (if char (list char) " ") "\t") ""))) names)) +(defun mule--ucs-names-group (name transform) + (if transform + name + (let* ((char (gethash name ucs-names)) + (script (and char (aref char-script-table char)))) + (if script (symbol-name script) "ungrouped")))) + (defun char-from-name (string &optional ignore-case) "Return a character as a number from its Unicode name STRING. If optional IGNORE-CASE is non-nil, ignore case in STRING. @@ -3104,6 +3132,15 @@ Return nil if STRING does not name a character." ignore-case)) code))))))) +(defcustom read-char-by-name-sort nil + "How to sort characters for `read-char-by-name' completion. +Defines the sorting order either by character names or their codepoints." + :type '(choice + (const :tag "Sort by character names" nil) + (const :tag "Sort by character codepoints" code)) + :group 'mule + :version "28.1") + (defun read-char-by-name (prompt) "Read a character by its Unicode name or hex number string. Display PROMPT and read a string that represents a character by its @@ -3117,6 +3154,10 @@ preceded by an asterisk `*' and use completion, it will show all the characters whose names include that substring, not necessarily at the beginning of the name. +The options `read-char-by-name-sort', `completions-group', and +`completions-group-sort' define the sorting order of completion characters, +whether to group them, and how to sort groups. + Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal number like \"2A10\", or a number in hash notation (e.g., \"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for @@ -3130,8 +3171,15 @@ as names, not numbers." prompt (lambda (string pred action) (if (eq action 'metadata) - '(metadata - (affixation-function . mule--ucs-names-affixation) + `(metadata + (display-sort-function + . ,(when (eq read-char-by-name-sort 'code) + #'mule--ucs-names-sort-by-code)) + (affixation-function + . ,#'mule--ucs-names-affixation) + (group-function + . ,(when completions-group + #'mule--ucs-names-group)) (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char |