diff options
Diffstat (limited to 'lisp/international/mule-cmds.el')
| -rw-r--r-- | lisp/international/mule-cmds.el | 111 |
1 files changed, 111 insertions, 0 deletions
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 |