diff options
Diffstat (limited to 'lisp/international')
| -rw-r--r-- | lisp/international/ccl.el | 2 | ||||
| -rw-r--r-- | lisp/international/fontset.el | 13 | ||||
| -rw-r--r-- | lisp/international/mule-cmds.el | 111 | ||||
| -rw-r--r-- | lisp/international/mule-conf.el | 1 | ||||
| -rw-r--r-- | lisp/international/mule-diag.el | 4 | ||||
| -rw-r--r-- | lisp/international/mule.el | 4 | ||||
| -rw-r--r-- | lisp/international/quail.el | 2 |
7 files changed, 129 insertions, 8 deletions
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 629cd4c2879..883b0b60fc9 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1553,7 +1553,7 @@ MAP := MAP-IDs := MAP-ID ... MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET MAP-ID := integer" - (declare (doc-string 3)) + (declare (doc-string 3) (indent defun)) `(let ((prog ,(unwind-protect (progn ;; To make ,(charset-id CHARSET) works well. diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index fcd22e09d29..7c3a7cd1a9e 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -816,11 +816,16 @@ (#x1D7EC #x1D7F5 mathematical-sans-serif-bold) (#x1D7F6 #x1D7FF mathematical-monospace))) (let ((slot (assq (nth 2 math-subgroup) script-representative-chars))) + ;; Add both ends of each subgroup to help filter out some + ;; incomplete fonts, e.g. those that cover MATHEMATICAL SCRIPT + ;; CAPITAL glyphs but not MATHEMATICAL SCRIPT SMALL ones. (if slot - (if (vectorp (cdr slot)) - (setcdr slot (vconcat (cdr slot) (vector (car math-subgroup)))) - (setcdr slot (vector (cadr slot) (car math-subgroup)))) - (setq slot (list (nth 2 math-subgroup) (car math-subgroup))) + (setcdr slot (append (list (nth 0 math-subgroup) + (nth 1 math-subgroup)) + (cdr slot))) + (setq slot (list (nth 2 math-subgroup) + (nth 0 math-subgroup) + (nth 1 math-subgroup))) (nconc script-representative-chars (list slot)))) (set-fontset-font "fontset-default" diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a0a6557c95c..91219ca480c 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2665,6 +2665,20 @@ For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"." locale)) locale)) +(defvar current-locale-environment nil + "The currently set locale environment.") + +(defmacro with-locale-environment (locale-name &rest body) + "Execute BODY with the locale set to LOCALE-NAME." + (declare (indent 1) (debug (sexp def-body))) + (let ((current (gensym))) + `(let ((,current current-locale-environment)) + (unwind-protect + (progn + (set-locale-environment ,locale-name) + ,@body) + (set-locale-environment ,current))))) + (defun set-locale-environment (&optional locale-name frame) "Set up multilingual environment for using LOCALE-NAME. This sets the language environment, the coding system priority, @@ -2690,6 +2704,10 @@ If FRAME is non-nil, only set the keyboard coding system and the terminal coding system for the terminal of that frame, and don't touch session-global parameters like the language environment. +This function sets the `current-locale-environment' variable. To +change the locale temporarily, `with-locale-environment' can be +used. + See also `locale-charset-language-names', `locale-language-names', `locale-preferred-coding-systems' and `locale-coding-system'." (interactive (list (completing-read "Set environment for locale: " @@ -2723,6 +2741,7 @@ See also `locale-charset-language-names', `locale-language-names', (when locale (setq locale (locale-translate locale)) + (setq current-locale-environment locale) ;; Leave the system locales alone if the caller did not specify ;; an explicit locale name, as their defaults are set from @@ -2927,6 +2946,7 @@ Optional 3rd argument DOCSTRING is a documentation string of the property. See also the documentation of `get-char-code-property' and `put-char-code-property'." + (declare (indent defun)) (or (symbolp name) (error "Not a symbol: %s" name)) (if (char-table-p table) @@ -3239,4 +3259,95 @@ as names, not numbers." (define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) +(defface confusingly-reordered + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :inherit warning)) + "Face for highlighting text that was bidi-reordered in confusing ways." + :version "29.1") + +(defvar reorder-starters "[\u202A\u202B\u202D\u202E\u2066-\u2068]+" + "Regular expression for characters that start forced-reordered text.") +(defvar reorder-enders "[\u202C\u2069]+\\|\n" + "Regular expression for characters that end forced-reordered text.") + +(autoload 'text-property-search-forward "text-property-search") +(autoload 'prop-match-beginning "text-property-search") +(autoload 'prop-match-end "text-property-search") + +(defun highlight-confusing-reorderings (beg end &optional remove) + "Highlight text in region that might be bidi-reordered in suspicious ways. +This command find and highlights segments of buffer text that could have +been reordered on display by using directional control characters, such +as RLO and LRI, in a way that their display is deliberately meant to +confuse the reader. These techniques can be used for obfuscating +malicious source code. The suspicious stretches of buffer text are +highlighted using the `confusingly-reordered' face. + +If the region is active, check the text inside the region. Otherwise +check the entire buffer. When called from Lisp, pass BEG and END to +specify the portion of the buffer to check. + +Optional argument REMOVE, if non-nil (interactively, prefix argument), +means remove the highlighting from the region between BEG and END, +or the active region if that is set." + (interactive + (if (use-region-p) + (list (region-beginning) (region-end) current-prefix-arg) + (list (point-min) (point-max) current-prefix-arg))) + (save-excursion + (if remove + (let (prop-match) + (goto-char beg) + (while (and + (setq prop-match + (text-property-search-forward 'font-lock-face + 'confusingly-reordered t)) + (< (prop-match-beginning prop-match) end)) + (with-silent-modifications + (remove-list-of-text-properties (prop-match-beginning prop-match) + (prop-match-end prop-match) + '(font-lock-face face mouse-face + help-echo))))) + (let (next) + (goto-char beg) + (while (setq next + (bidi-find-overridden-directionality + (point) end nil + (current-bidi-paragraph-direction))) + (goto-char next) + ;; We detect the problematic parts by watching directional + ;; properties of strong L2R and R2L characters. But + ;; malicious reordering in source buffers can, and usuually + ;; does, include syntactically-important punctuation + ;; characters. Those have "weak" directionality, so we + ;; cannot easily detect when they are affected in malicious + ;; ways. Therefore, once we find a strong directional + ;; character whose directionality was tweaked, we highlight + ;; the text around it, between the first bidi control + ;; character we find before it that starts an + ;; override/embedding/isolate, and the first control after + ;; it that ends these. This could sometimes highlight only + ;; part of the affected text. An alternative would be to + ;; find the first "starter" following BOL and the last + ;; "ender" before EOL, and highlight everything in between + ;; them -- this could sometimes highlight too much. + (let ((start + (save-excursion + (re-search-backward reorder-starters nil t))) + (finish + (save-excursion + (re-search-forward reorder-enders nil t)))) + (with-silent-modifications + (add-text-properties start (1- finish) + '(font-lock-face + confusingly-reordered + face confusingly-reordered + mouse-face highlight + help-echo "\ +This text is reordered on display in a way that could change its semantics; +use \\[forward-char] and \\[backward-char] to see the actual order of characters."))) + (goto-char finish))))))) + ;;; mule-cmds.el ends here diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 9a68fce2e81..ec027e9a932 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -148,6 +148,7 @@ (defmacro define-iso-single-byte-charset (symbol iso-symbol name nickname iso-ir iso-final emacs-mule-id map) + (declare (indent defun)) `(progn (define-charset ,symbol ,name diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 862c577bd5d..5cc73e43671 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -833,7 +833,7 @@ The IGNORED argument is ignored." "Display information about a font whose name is FONTNAME." (interactive (list (completing-read - "Font name (default current choice for ASCII chars): " + (format-prompt "Font name" "current choice for ASCII chars") (and window-system ;; Implied by `window-system'. (fboundp 'x-list-fonts) @@ -1004,7 +1004,7 @@ This shows which font is used for which character(s)." (mapcar 'cdr fontset-alias-alist))) (completion-ignore-case t)) (list (completing-read - "Fontset (default used by the current frame): " + (format-prompt "Fontset" "used by the current frame") fontset-list nil t))))) (if (= (length fontset) 0) (setq fontset (face-attribute 'default :fontset)) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 5022a17db5a..3e45a64dc9a 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -218,6 +218,7 @@ corresponding Unicode character code. If it is a string, it is a name of file that contains the above information. The file format is the same as what described for `:map' attribute." + (declare (indent defun)) (when (vectorp (car props)) ;; Old style code: ;; (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR) @@ -890,6 +891,7 @@ non-nil. VALUE non-nil means Emacs prefers UTF-8 on code detection for non-ASCII files. This attribute is meaningful only when `:coding-type' is `undecided'." + (declare (indent defun)) (let* ((common-attrs (mapcar 'list '(:mnemonic :coding-type @@ -2320,6 +2322,7 @@ This function sets properties `translation-table' and `translation-table-id' of SYMBOL to the created table itself and the identification number of the table respectively. It also registers the table in `translation-table-vector'." + (declare (indent defun)) (let ((table (if (and (char-table-p (car args)) (eq (char-table-subtype (car args)) 'translation-table)) @@ -2394,6 +2397,7 @@ Value is what BODY returns." Analogous to `define-translation-table', but updates `translation-hash-table-vector' and the table is for use in the CCL `lookup-integer' and `lookup-character' functions." + (declare (indent defun)) (unless (and (symbolp symbol) (hash-table-p table)) (error "Bad args to define-translation-hash-table")) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index ee935b11ec0..5cdd6d6242b 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -917,7 +917,7 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'." The variable `quail-keyboard-layout-type' holds the currently selected keyboard type." (interactive - (list (completing-read "Keyboard type (default current choice): " + (list (completing-read (format-prompt "Keyboard type" "current choice") quail-keyboard-layout-alist nil t))) (or (and keyboard-type (> (length keyboard-type) 0)) |