diff options
Diffstat (limited to 'lisp/disp-table.el')
| -rw-r--r-- | lisp/disp-table.el | 96 |
1 files changed, 83 insertions, 13 deletions
diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 1410e273298..f0ee3d1d780 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -1,6 +1,6 @@ -;;; disp-table.el --- functions for dealing with char tables +;;; disp-table.el --- functions for dealing with char tables -*- lexical-binding: t; -*- -;; Copyright (C) 1987, 1994-1995, 1999, 2001-2017 Free Software +;; Copyright (C) 1987, 1994-1995, 1999, 2001-2022 Free Software ;; Foundation, Inc. ;; Author: Erik Naggum <erik@naggum.no> @@ -175,8 +175,8 @@ in the default way after this call." (defun standard-display-g1 (c sc) "Display character C as character SC in the g1 character set. This function assumes that your terminal uses the SO/SI characters; -it is meaningless for an X frame." - (if (memq window-system '(x w32 ns)) +it is meaningless for a graphical frame." + (if (display-graphic-p) (error "Cannot use string glyphs in a windowing system")) (or standard-display-table (setq standard-display-table (make-display-table))) @@ -186,9 +186,9 @@ it is meaningless for an X frame." ;;;###autoload (defun standard-display-graphic (c gc) "Display character C as character GC in graphics character set. -This function assumes VT100-compatible escapes; it is meaningless for an -X frame." - (if (memq window-system '(x w32 ns)) +This function assumes VT100-compatible escapes; it is meaningless +for a graphical frame." + (if (display-graphic-p) (error "Cannot use string glyphs in a windowing system")) (or standard-display-table (setq standard-display-table (make-display-table))) @@ -220,13 +220,11 @@ X frame." ;;;###autoload (defun make-glyph-code (char &optional face) "Return a glyph code representing char CHAR with face FACE." - ;; Due to limitations on Emacs integer values, faces with - ;; face id greater that 512 are silently ignored. (if (not face) char (let ((fid (face-id face))) (if (< fid 64) ; we have 32 - 3(LSB) - 1(SIGN) - 22(CHAR) = 6 bits for face id - (logior char (lsh fid 22)) + (logior char (ash fid 22)) (cons char fid))))) ;;;###autoload @@ -239,7 +237,7 @@ X frame." ;;;###autoload (defun glyph-face (glyph) "Return the face of glyph code GLYPH, or nil if glyph has default face." - (let ((face-id (if (consp glyph) (cdr glyph) (lsh glyph -22)))) + (let ((face-id (if (consp glyph) (cdr glyph) (ash glyph -22)))) (and (> face-id 0) (catch 'face (dolist (face (face-list)) @@ -276,7 +274,7 @@ in `.emacs'." (progn (standard-display-default (unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255)) - (unless (or (memq window-system '(x w32 ns))) + (unless (display-graphic-p) (and (terminal-coding-system) (set-terminal-coding-system nil)))) @@ -289,7 +287,7 @@ in `.emacs'." ;; unless some other has been specified. (if (equal current-language-environment "English") (set-language-environment "latin-1")) - (unless (or noninteractive (memq window-system '(x w32 ns))) + (unless (or noninteractive (display-graphic-p)) ;; Send those codes literally to a character-based terminal. ;; If we are using single-byte characters, ;; it doesn't matter which coding system we use. @@ -298,6 +296,78 @@ in `.emacs'." (if (coding-system-p c) c 'latin-1)))) (standard-display-european-internal))) + +;;;###autoload +(defun standard-display-by-replacement-char (&optional repl from to) + "Produce code to display characters between FROM and TO using REPL. +This function produces a buffer with code to set up `standard-display-table' +such that characters that cannot be displayed by the terminal, and +don't already have their display set up in `standard-display-table', will +be represented by a replacement character. You can evaluate the produced +code to use the setup for the current Emacs session, or copy the code +into your init file, to make Emacs use it for subsequent sessions. + +Interactively, the produced code arranges for any character in +the range [#x100..#x10FFFF] that the terminal cannot display to +be represented by the #xFFFD Unicode replacement character. + +When called from Lisp, FROM and TO define the range of characters for +which to produce the setup code for `standard-display-table'. If they +are omitted, they default to #x100 and #x10FFFF respectively, covering +the entire non-ASCII range of Unicode characters. +REPL is the replacement character to use. If it's omitted, it defaults +to #xFFFD, the Unicode replacement character, usually displayed as a +black diamond with a question mark inside. +The produced code sets up `standard-display-table' to show REPL with +the `homoglyph' face, making the replacements stand out on display. + +This command is most useful with text-mode terminals, such as the +Linux console, for which Emacs has a reliable way of determining +which characters can be displayed and which cannot." + (interactive) + (or repl + (setq repl #xfffd)) + (or (and from to (<= from to)) + (setq from #x100 + to (max-char 'unicode))) + (let ((buf (get-buffer-create "*Display replacements*")) + (ch from) + (tbl standard-display-table) + first) + (with-current-buffer buf + (erase-buffer) + (insert "\ +;; This code was produced by `standard-display-by-replacement-char'. +;; Evaluate the Lisp code below to make Emacs show the standard +;; replacement character as a substitute for each undisplayable character. +;; One way to do that is with \"C-x h M-x eval-region RET\". +;; Normally you would put this code in your Emacs initialization file, +;; perhaps conditionally based on the type of terminal, so that +;; this setup happens automatically on each startup. +(let ((tbl (or standard-display-table + (setq standard-display-table (make-display-table)))))\n") + (while (<= ch to) + (cond + ((or (char-displayable-p ch) + (aref tbl ch)) + (setq ch (1+ ch))) + (t + (setq first ch) + (while (and (<= ch to) + (not (or (char-displayable-p ch) + (aref tbl ch)))) + (setq ch (1+ ch))) + (insert + " (set-char-table-range tbl '(" + (format "#x%x" first) + " . " + (format "#x%x" (1- ch)) + ")\n\ (vconcat (list (make-glyph-code " + (format "#x%x" repl) " 'homoglyph))))\n")))) + (insert ")\n")) + (pop-to-buffer buf))) + + (provide 'disp-table) ;;; disp-table.el ends here |