2021-01-05 01:57:42 +00:00
|
|
|
;;; disp-table.el --- functions for dealing with char tables -*- lexical-binding: t; -*-
|
1992-05-30 23:54:21 +00:00
|
|
|
|
2021-01-01 09:13:56 +00:00
|
|
|
;; Copyright (C) 1987, 1994-1995, 1999, 2001-2021 Free Software
|
2013-01-01 09:11:05 +00:00
|
|
|
;; Foundation, Inc.
|
1992-07-22 04:22:30 +00:00
|
|
|
|
1995-10-09 17:45:47 +00:00
|
|
|
;; Author: Erik Naggum <erik@naggum.no>
|
|
|
|
;; Based on a previous version by Howard Gayle
|
2019-05-25 20:43:06 +00:00
|
|
|
;; Maintainer: emacs-devel@gnu.org
|
1993-05-24 07:55:58 +00:00
|
|
|
;; Keywords: i18n
|
2010-08-29 16:17:13 +00:00
|
|
|
;; Package: emacs
|
1989-10-31 16:00:07 +00:00
|
|
|
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
|
2008-05-06 08:06:51 +00:00
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
1989-10-31 16:00:07 +00:00
|
|
|
;; it under the terms of the GNU General Public License as published by
|
2008-05-06 08:06:51 +00:00
|
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
|
|
;; (at your option) any later version.
|
1989-10-31 16:00:07 +00:00
|
|
|
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
;; GNU General Public License for more details.
|
|
|
|
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
2017-09-13 22:52:52 +00:00
|
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
1989-10-31 16:00:07 +00:00
|
|
|
|
2001-07-15 16:15:35 +00:00
|
|
|
;;; Commentary:
|
|
|
|
|
1992-07-16 21:47:34 +00:00
|
|
|
;;; Code:
|
1989-10-31 16:00:07 +00:00
|
|
|
|
1995-10-12 19:16:20 +00:00
|
|
|
(put 'display-table 'char-table-extra-slots 6)
|
1994-09-19 17:31:15 +00:00
|
|
|
|
1995-10-09 17:45:47 +00:00
|
|
|
;;;###autoload
|
|
|
|
(defun make-display-table ()
|
|
|
|
"Return a new, empty display table."
|
1995-10-12 19:16:20 +00:00
|
|
|
(make-char-table 'display-table nil))
|
1995-10-09 17:45:47 +00:00
|
|
|
|
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
|
|
|
|
1995-10-12 19:16:20 +00:00
|
|
|
;;; Display-table slot names. The property value says which slot.
|
|
|
|
|
|
|
|
(put 'truncation 'display-table-slot 0)
|
|
|
|
(put 'wrap 'display-table-slot 1)
|
|
|
|
(put 'escape 'display-table-slot 2)
|
|
|
|
(put 'control 'display-table-slot 3)
|
|
|
|
(put 'selective-display 'display-table-slot 4)
|
|
|
|
(put 'vertical-border 'display-table-slot 5)
|
1995-10-09 17:45:47 +00:00
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
(defun display-table-slot (display-table slot)
|
|
|
|
"Return the value of the extra slot in DISPLAY-TABLE named SLOT.
|
1995-12-03 01:51:01 +00:00
|
|
|
SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol).
|
|
|
|
Valid symbols are `truncation', `wrap', `escape', `control',
|
|
|
|
`selective-display', and `vertical-border'."
|
1995-10-09 17:45:47 +00:00
|
|
|
(let ((slot-number
|
|
|
|
(if (numberp slot) slot
|
1995-10-12 19:16:20 +00:00
|
|
|
(or (get slot 'display-table-slot)
|
1995-10-09 17:45:47 +00:00
|
|
|
(error "Invalid display-table slot name: %s" slot)))))
|
|
|
|
(char-table-extra-slot display-table slot-number)))
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
(defun set-display-table-slot (display-table slot value)
|
|
|
|
"Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE.
|
|
|
|
SLOT may be a number from 0 to 5 inclusive, or a name (symbol).
|
1995-12-03 01:51:01 +00:00
|
|
|
Valid symbols are `truncation', `wrap', `escape', `control',
|
|
|
|
`selective-display', and `vertical-border'."
|
1995-10-12 19:16:20 +00:00
|
|
|
(let ((slot-number
|
|
|
|
(if (numberp slot) slot
|
|
|
|
(or (get slot 'display-table-slot)
|
|
|
|
(error "Invalid display-table slot name: %s" slot)))))
|
|
|
|
(set-char-table-extra-slot display-table slot-number value)))
|
1995-10-09 17:45:47 +00:00
|
|
|
|
|
|
|
;;;###autoload
|
1993-03-08 08:11:01 +00:00
|
|
|
(defun describe-display-table (dt)
|
1992-03-16 20:39:07 +00:00
|
|
|
"Describe the display table DT in a help buffer."
|
2007-11-10 09:56:32 +00:00
|
|
|
(with-help-window "*Help*"
|
1992-06-07 04:20:03 +00:00
|
|
|
(princ "\nTruncation glyph: ")
|
1995-10-12 19:16:20 +00:00
|
|
|
(prin1 (display-table-slot dt 'truncation))
|
1992-06-07 04:20:03 +00:00
|
|
|
(princ "\nWrap glyph: ")
|
1995-10-12 19:16:20 +00:00
|
|
|
(prin1 (display-table-slot dt 'wrap))
|
1992-06-07 04:20:03 +00:00
|
|
|
(princ "\nEscape glyph: ")
|
1995-10-12 19:16:20 +00:00
|
|
|
(prin1 (display-table-slot dt 'escape))
|
1992-06-07 04:20:03 +00:00
|
|
|
(princ "\nCtrl glyph: ")
|
1995-10-12 19:16:20 +00:00
|
|
|
(prin1 (display-table-slot dt 'control))
|
1993-05-03 03:35:53 +00:00
|
|
|
(princ "\nSelective display glyph sequence: ")
|
1995-10-12 19:16:20 +00:00
|
|
|
(prin1 (display-table-slot dt 'selective-display))
|
1994-09-19 17:31:15 +00:00
|
|
|
(princ "\nVertical window border glyph: ")
|
1995-10-12 19:16:20 +00:00
|
|
|
(prin1 (display-table-slot dt 'vertical-border))
|
1993-05-03 03:35:53 +00:00
|
|
|
(princ "\nCharacter display glyph sequences:\n")
|
* x-dnd.el (x-dnd-maybe-call-test-function):
* window.el (split-window-vertically):
* whitespace.el (whitespace-help-on):
* vc-rcs.el (vc-rcs-consult-headers):
* userlock.el (ask-user-about-lock-help)
(ask-user-about-supersession-help):
* type-break.el (type-break-force-mode-line-update):
* time-stamp.el (time-stamp-conv-warn):
* terminal.el (te-set-output-log, te-more-break, te-filter)
(te-sentinel,terminal-emulator):
* term.el (make-term, term-exec, term-sentinel, term-read-input-ring)
(term-write-input-ring, term-check-source, term-start-output-log):
(term-display-buffer-line, term-dynamic-list-completions):
(term-ansi-make-term, serial-term):
* subr.el (selective-display):
* strokes.el (strokes-xpm-to-compressed-string, strokes-decode-buffer)
(strokes-encode-buffer, strokes-xpm-for-compressed-string):
* speedbar.el (speedbar-buffers-tail-notes, speedbar-buffers-item-info)
(speedbar-reconfigure-keymaps, speedbar-add-localized-speedbar-support)
(speedbar-remove-localized-speedbar-support)
(speedbar-set-mode-line-format, speedbar-create-tag-hierarchy)
(speedbar-update-special-contents, speedbar-buffer-buttons-engine)
(speedbar-buffers-line-directory):
* simple.el (shell-command-on-region, append-to-buffer)
(prepend-to-buffer):
* shadowfile.el (shadow-save-todo-file):
* scroll-bar.el (scroll-bar-set-window-start, scroll-bar-drag-1)
(scroll-bar-maybe-set-window-start):
* sb-image.el (speedbar-image-dump):
* saveplace.el (save-place-alist-to-file, save-places-to-alist)
(load-save-place-alist-from-file):
* ps-samp.el (ps-print-message-from-summary):
* ps-print.el (ps-flush-output, ps-insert-file, ps-get-boundingbox)
(ps-background-image, ps-begin-job, ps-do-despool):
* ps-bdf.el (bdf-find-file, bdf-read-font-info):
* printing.el (pr-interface, pr-ps-file-print, pr-find-buffer-visiting)
(pr-ps-message-from-summary, pr-lpr-message-from-summary):
(pr-call-process, pr-file-list, pr-interface-save):
* novice.el (disabled-command-function)
(enable-command, disable-command):
* mouse.el (mouse-buffer-menu-alist):
* mouse-copy.el (mouse-kill-preserving-secondary):
* macros.el (kbd-macro-query):
* ledit.el (ledit-go-to-lisp, ledit-go-to-liszt):
* informat.el (batch-info-validate):
* ido.el (ido-copy-current-word, ido-initiate-auto-merge):
* hippie-exp.el (try-expand-dabbrev-visible):
* help-mode.el (help-make-xrefs):
* help-fns.el (describe-variable):
* generic-x.el (bat-generic-mode-run-as-comint):
* finder.el (finder-mouse-select):
* find-dired.el (find-dired-sentinel):
* filesets.el (filesets-file-close):
* files.el (list-directory):
* faces.el (list-faces-display, describe-face):
* facemenu.el (list-colors-display):
* ezimage.el (ezimage-image-association-dump, ezimage-image-dump):
* epg.el (epg--process-filter, epg-cancel):
* epa.el (epa--marked-keys, epa--select-keys, epa-display-info)
(epa--read-signature-type):
* emerge.el (emerge-copy-as-kill-A, emerge-copy-as-kill-B)
(emerge-file-names):
* ehelp.el (electric-helpify):
* ediff.el (ediff-regions-wordwise, ediff-regions-linewise):
* ediff-vers.el (rcs-ediff-view-revision):
* ediff-util.el (ediff-setup):
* ediff-mult.el (ediff-append-custom-diff):
* ediff-diff.el (ediff-exec-process, ediff-process-sentinel)
(ediff-wordify):
* echistory.el (Electric-command-history-redo-expression):
* dos-w32.el (find-file-not-found-set-buffer-file-coding-system):
* disp-table.el (describe-display-table):
* dired.el (dired-find-buffer-nocreate):
* dired-aux.el (dired-rename-subdir, dired-dwim-target-directory):
* dabbrev.el (dabbrev--same-major-mode-p):
* chistory.el (list-command-history):
* apropos.el (apropos-documentation):
* allout.el (allout-obtain-passphrase):
(allout-copy-exposed-to-buffer):
(allout-verify-passphrase): Use with-current-buffer.
2009-11-13 22:19:45 +00:00
|
|
|
(with-current-buffer standard-output
|
1993-11-08 15:06:59 +00:00
|
|
|
(let ((vector (make-vector 256 nil))
|
|
|
|
(i 0))
|
|
|
|
(while (< i 256)
|
|
|
|
(aset vector i (aref dt i))
|
|
|
|
(setq i (1+ i)))
|
2011-07-02 12:27:53 +00:00
|
|
|
(describe-vector
|
|
|
|
vector 'display-table-print-array))
|
2007-11-10 09:56:32 +00:00
|
|
|
(help-mode))))
|
1989-10-31 16:00:07 +00:00
|
|
|
|
2011-07-02 12:27:53 +00:00
|
|
|
(defun display-table-print-array (desc)
|
|
|
|
(insert "[")
|
|
|
|
(let ((column (current-column))
|
|
|
|
(width (window-width))
|
|
|
|
string)
|
|
|
|
(dotimes (i (length desc))
|
|
|
|
(setq string (format "%s" (aref desc i)))
|
|
|
|
(cond
|
|
|
|
((>= (+ (current-column) (length string) 1)
|
|
|
|
width)
|
|
|
|
(insert "\n")
|
|
|
|
(insert (make-string column ? )))
|
|
|
|
((> i 0)
|
|
|
|
(insert " ")))
|
|
|
|
(insert string)))
|
|
|
|
(insert "]\n"))
|
|
|
|
|
1993-03-08 08:11:01 +00:00
|
|
|
;;;###autoload
|
1989-10-31 16:00:07 +00:00
|
|
|
(defun describe-current-display-table ()
|
1993-11-08 15:06:59 +00:00
|
|
|
"Describe the display table in use in the selected window and buffer."
|
|
|
|
(interactive)
|
Do not call to `selected-window' where it is assumed by default.
Affected functions are `window-minibuffer-p', `window-dedicated-p',
`window-hscroll', `window-width', `window-height', `window-buffer',
`window-frame', `window-start', `window-point', `next-window'
and `window-display-table'.
* abbrev.el (abbrev--default-expand):
* bs.el (bs--show-with-configuration):
* buff-menu.el (Buffer-menu-mouse-select):
* calc/calc.el (calc):
* calendar/calendar.el (calendar-generate-window):
* calendar/diary-lib.el (diary-simple-display, diary-show-all-entries)
(diary-make-entry):
* comint.el (send-invisible, comint-dynamic-complete-filename)
(comint-dynamic-simple-complete, comint-dynamic-list-completions):
* completion.el (complete):
* dabbrev.el (dabbrev-expand, dabbrev--make-friend-buffer-list):
* disp-table.el (describe-current-display-table):
* doc-view.el (doc-view-insert-image):
* ebuff-menu.el (Electric-buffer-menu-mouse-select):
* ehelp.el (with-electric-help):
* emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
* emacs-lisp/edebug.el (edebug-two-window-p, edebug-pop-to-buffer):
* emacs-lisp/helper.el (Helper-help-scroller):
* emulation/cua-base.el (cua--post-command-handler-1):
* eshell/esh-mode.el (eshell-output-filter):
* ffap.el (ffap-gnus-wrapper):
* help-macro.el (make-help-screen):
* hilit-chg.el (highlight-compare-buffers):
* hippie-exp.el (hippie-expand, try-expand-dabbrev-visible):
* hl-line.el (global-hl-line-highlight):
* icomplete.el (icomplete-simple-completing-p):
* isearch.el (isearch-done):
* jit-lock.el (jit-lock-stealth-fontify):
* mail/rmailsum.el (rmail-summary-scroll-msg-up):
* lisp/mouse-drag.el (mouse-drag-should-do-col-scrolling):
* mpc.el (mpc-tagbrowser, mpc):
* net/rcirc.el (rcirc-any-buffer):
* play/gomoku.el (gomoku-max-width, gomoku-max-height):
* play/landmark.el (landmark-max-width, landmark-max-height):
* play/zone.el (zone):
* progmodes/compile.el (compilation-goto-locus):
* progmodes/ebrowse.el (ebrowse-view/find-file-and-search-pattern):
* progmodes/etags.el (find-tag-other-window):
* progmodes/fortran.el (fortran-column-ruler):
* progmodes/gdb-mi.el (gdb-mouse-toggle-breakpoint-fringe):
* progmodes/verilog-mode.el (verilog-point-text):
* reposition.el (reposition-window):
* rot13.el (toggle-rot13-mode):
* server.el (server-switch-buffer):
* shell.el (shell-dynamic-complete-command)
(shell-dynamic-complete-environment-variable):
* simple.el (insert-buffer, set-selective-display)
(delete-completion-window):
* speedbar.el (speedbar-timer-fn, speedbar-center-buffer-smartly)
(speedbar-recenter):
* startup.el (fancy-splash-head):
* textmodes/ispell.el (ispell-command-loop):
* textmodes/makeinfo.el (makeinfo-compilation-sentinel-region):
* tutorial.el (help-with-tutorial):
* vc/add-log.el (add-change-log-entry):
* vc/compare-w.el (compare-windows):
* vc/ediff-help.el (ediff-indent-help-message):
* vc/ediff-util.el (ediff-setup-control-buffer, ediff-position-region):
* vc/ediff-wind.el (ediff-skip-unsuitable-frames)
(ediff-setup-control-frame):
* vc/emerge.el (emerge-position-region):
* vc/pcvs-util.el (cvs-bury-buffer):
* window.el (walk-windows, mouse-autoselect-window-select):
* winner.el (winner-set-conf, winner-undo): Related users changed.
2013-08-05 14:26:57 +00:00
|
|
|
(let ((disptab (or (window-display-table)
|
1995-10-09 17:45:47 +00:00
|
|
|
buffer-display-table
|
|
|
|
standard-display-table)))
|
1993-11-08 15:06:59 +00:00
|
|
|
(if disptab
|
|
|
|
(describe-display-table disptab)
|
|
|
|
(message "No display table"))))
|
1989-10-31 16:00:07 +00:00
|
|
|
|
1993-03-08 08:11:01 +00:00
|
|
|
;;;###autoload
|
1989-10-31 16:00:07 +00:00
|
|
|
(defun standard-display-8bit (l h)
|
2010-08-31 07:49:21 +00:00
|
|
|
"Display characters representing raw bytes in the range L to H literally.
|
|
|
|
|
|
|
|
On a terminal display, each character in the range is displayed
|
|
|
|
by sending the corresponding byte directly to the terminal.
|
|
|
|
|
|
|
|
On a graphic display, each character in the range is displayed
|
|
|
|
using the default font by a glyph whose code is the corresponding
|
|
|
|
byte.
|
|
|
|
|
|
|
|
Note that ASCII printable characters (SPC to TILDA) are displayed
|
|
|
|
in the default way after this call."
|
2004-04-16 12:51:06 +00:00
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
2010-08-31 07:49:21 +00:00
|
|
|
(if (> h 255)
|
|
|
|
(setq h 255))
|
1989-10-31 16:00:07 +00:00
|
|
|
(while (<= l h)
|
2010-08-31 07:49:21 +00:00
|
|
|
(if (< l 128)
|
|
|
|
(aset standard-display-table l
|
|
|
|
(if (or (< l ?\s) (= l 127)) (vector l)))
|
|
|
|
(let ((c (unibyte-char-to-multibyte l)))
|
|
|
|
(aset standard-display-table c (vector c))))
|
1989-10-31 16:00:07 +00:00
|
|
|
(setq l (1+ l))))
|
|
|
|
|
1993-05-24 21:13:21 +00:00
|
|
|
;;;###autoload
|
|
|
|
(defun standard-display-default (l h)
|
|
|
|
"Display characters in the range L to H using the default notation."
|
2004-04-16 12:51:06 +00:00
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
1993-05-24 21:13:21 +00:00
|
|
|
(while (<= l h)
|
2006-12-07 04:14:14 +00:00
|
|
|
(if (and (>= l ?\s) (characterp l))
|
2000-08-24 16:16:21 +00:00
|
|
|
(aset standard-display-table l nil))
|
1993-05-24 21:13:21 +00:00
|
|
|
(setq l (1+ l))))
|
|
|
|
|
1995-01-16 22:57:31 +00:00
|
|
|
;; This function does NOT take terminal-dependent escape sequences.
|
|
|
|
;; For that, you need to go through create-glyph. Use one of the
|
|
|
|
;; other functions below, or roll your own.
|
1995-10-09 17:45:47 +00:00
|
|
|
;;;###autoload
|
1989-10-31 16:00:07 +00:00
|
|
|
(defun standard-display-ascii (c s)
|
1995-01-16 22:57:31 +00:00
|
|
|
"Display character C using printable string S."
|
2004-04-16 12:51:06 +00:00
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
1995-10-09 17:45:47 +00:00
|
|
|
(aset standard-display-table c (vconcat s)))
|
1989-10-31 16:00:07 +00:00
|
|
|
|
1993-03-08 08:11:01 +00:00
|
|
|
;;;###autoload
|
1989-10-31 16:00:07 +00:00
|
|
|
(defun standard-display-g1 (c sc)
|
1994-03-19 03:48:55 +00:00
|
|
|
"Display character C as character SC in the g1 character set.
|
|
|
|
This function assumes that your terminal uses the SO/SI characters;
|
2019-04-03 19:57:16 +00:00
|
|
|
it is meaningless for a graphical frame."
|
|
|
|
(if (display-graphic-p)
|
1994-03-19 03:48:55 +00:00
|
|
|
(error "Cannot use string glyphs in a windowing system"))
|
2004-04-16 12:51:06 +00:00
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
1989-10-31 16:00:07 +00:00
|
|
|
(aset standard-display-table c
|
1993-04-12 07:54:04 +00:00
|
|
|
(vector (create-glyph (concat "\016" (char-to-string sc) "\017")))))
|
1989-10-31 16:00:07 +00:00
|
|
|
|
1993-03-08 08:11:01 +00:00
|
|
|
;;;###autoload
|
1989-10-31 16:00:07 +00:00
|
|
|
(defun standard-display-graphic (c gc)
|
1994-03-19 03:48:55 +00:00
|
|
|
"Display character C as character GC in graphics character set.
|
2019-04-03 19:57:16 +00:00
|
|
|
This function assumes VT100-compatible escapes; it is meaningless
|
|
|
|
for a graphical frame."
|
|
|
|
(if (display-graphic-p)
|
1994-03-19 03:48:55 +00:00
|
|
|
(error "Cannot use string glyphs in a windowing system"))
|
2004-04-16 12:51:06 +00:00
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
1989-10-31 16:00:07 +00:00
|
|
|
(aset standard-display-table c
|
1993-04-12 07:54:04 +00:00
|
|
|
(vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
|
1989-10-31 16:00:07 +00:00
|
|
|
|
1993-03-08 08:11:01 +00:00
|
|
|
;;;###autoload
|
1989-10-31 16:00:07 +00:00
|
|
|
(defun standard-display-underline (c uc)
|
|
|
|
"Display character C as character UC plus underlining."
|
2004-04-16 12:51:06 +00:00
|
|
|
(or standard-display-table
|
|
|
|
(setq standard-display-table (make-display-table)))
|
1989-10-31 16:00:07 +00:00
|
|
|
(aset standard-display-table c
|
2003-02-04 11:26:42 +00:00
|
|
|
(vector
|
1994-03-19 03:48:55 +00:00
|
|
|
(if window-system
|
2007-02-14 11:28:40 +00:00
|
|
|
(make-glyph-code uc 'underline)
|
1994-03-19 03:48:55 +00:00
|
|
|
(create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
|
1992-06-07 04:20:03 +00:00
|
|
|
|
1993-03-08 08:11:01 +00:00
|
|
|
;;;###autoload
|
1992-06-07 04:20:03 +00:00
|
|
|
(defun create-glyph (string)
|
2000-06-08 16:58:41 +00:00
|
|
|
"Allocate a glyph code to display by sending STRING to the terminal."
|
1992-06-07 04:20:03 +00:00
|
|
|
(if (= (length glyph-table) 65536)
|
|
|
|
(error "No free glyph codes remain"))
|
1994-03-19 03:00:25 +00:00
|
|
|
;; Don't use slots that correspond to ASCII characters.
|
|
|
|
(if (= (length glyph-table) 32)
|
|
|
|
(setq glyph-table (vconcat glyph-table (make-vector 224 nil))))
|
1992-06-07 04:20:03 +00:00
|
|
|
(setq glyph-table (vconcat glyph-table (list string)))
|
|
|
|
(1- (length glyph-table)))
|
1989-10-31 16:00:07 +00:00
|
|
|
|
2007-02-14 11:28:40 +00:00
|
|
|
;;;###autoload
|
|
|
|
(defun make-glyph-code (char &optional face)
|
|
|
|
"Return a glyph code representing char CHAR with face FACE."
|
2008-02-27 22:53:11 +00:00
|
|
|
(if (not face)
|
|
|
|
char
|
|
|
|
(let ((fid (face-id face)))
|
2008-03-01 15:40:44 +00:00
|
|
|
(if (< fid 64) ; we have 32 - 3(LSB) - 1(SIGN) - 22(CHAR) = 6 bits for face id
|
Audit use of lsh and fix glitches
I audited use of lsh in the Lisp source code, and fixed the
glitches that I found. While I was at it, I replaced uses of lsh
with ash when either will do. Replacement is OK when either
argument is known to be nonnegative, or when only the low-order
bits of the result matter, and is a (minor) win since ash is a bit
more solid than lsh nowadays, and is a bit faster.
* lisp/calc/calc-ext.el (math-check-fixnum):
Prefer most-positive-fixnum to (lsh -1 -1).
* lisp/vc/vc-hg.el (vc-hg-state-fast): When testing fixnum width,
prefer (zerop (ash most-positive-fixnum -32)) to (zerop (lsh -1
32)) (Bug#32485#11).
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode):
Tighten sanity-check for bytecode overflow, by checking that the
result of (ash pc -8) is nonnegative. Formerly this check was not
needed since lsh was used and the number overflowed differently.
* lisp/net/dns.el (dns-write): Fix some obvious sign typos in
shift counts. Evidently this part of the code has never been
exercised.
* lisp/progmodes/hideif.el (hif-shiftleft, hif-shiftright):
* lisp/term/common-win.el (x-setup-function-keys):
Simplify.
* admin/unidata/unidata-gen.el, admin/unidata/uvs.el:
* doc/lispref/keymaps.texi, doc/lispref/syntax.texi:
* doc/misc/calc.texi, doc/misc/cl.texi, etc/NEWS.19:
* lisp/arc-mode.el, lisp/calc/calc-bin.el, lisp/calc/calc-comb.el:
* lisp/calc/calc-ext.el, lisp/calc/calc-math.el:
* lisp/cedet/semantic/wisent/comp.el, lisp/composite.el:
* lisp/disp-table.el, lisp/dos-fns.el, lisp/edmacro.el:
* lisp/emacs-lisp/bindat.el, lisp/emacs-lisp/byte-opt.el:
* lisp/emacs-lisp/bytecomp.el, lisp/emacs-lisp/cl-extra.el:
* lisp/erc/erc-dcc.el, lisp/facemenu.el, lisp/gnus/message.el:
* lisp/gnus/nndoc.el, lisp/gnus/nnmaildir.el, lisp/image.el:
* lisp/international/ccl.el, lisp/international/fontset.el:
* lisp/international/mule-cmds.el, lisp/international/mule.el:
* lisp/json.el, lisp/mail/binhex.el, lisp/mail/rmail.el:
* lisp/mail/uudecode.el, lisp/md4.el, lisp/net/dns.el:
* lisp/net/ntlm.el, lisp/net/sasl.el, lisp/net/socks.el:
* lisp/net/tramp.el, lisp/obsolete/levents.el:
* lisp/obsolete/pgg-parse.el, lisp/org/org.el:
* lisp/org/ox-publish.el, lisp/progmodes/cc-defs.el:
* lisp/progmodes/ebnf2ps.el, lisp/progmodes/hideif.el:
* lisp/ps-bdf.el, lisp/ps-print.el, lisp/simple.el:
* lisp/tar-mode.el, lisp/term/common-win.el:
* lisp/term/tty-colors.el, lisp/term/xterm.el, lisp/vc/vc-git.el:
* lisp/vc/vc-hg.el, lisp/x-dnd.el, test/src/data-tests.el:
Prefer ash to lsh when either will do.
2018-08-21 20:44:03 +00:00
|
|
|
(logior char (ash fid 22))
|
2008-03-01 15:40:44 +00:00
|
|
|
(cons char fid)))))
|
2007-02-14 11:28:40 +00:00
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
(defun glyph-char (glyph)
|
|
|
|
"Return the character of glyph code GLYPH."
|
2008-02-27 22:53:11 +00:00
|
|
|
(if (consp glyph)
|
|
|
|
(car glyph)
|
|
|
|
(logand glyph #x3fffff)))
|
2007-02-14 11:28:40 +00:00
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
(defun glyph-face (glyph)
|
|
|
|
"Return the face of glyph code GLYPH, or nil if glyph has default face."
|
Audit use of lsh and fix glitches
I audited use of lsh in the Lisp source code, and fixed the
glitches that I found. While I was at it, I replaced uses of lsh
with ash when either will do. Replacement is OK when either
argument is known to be nonnegative, or when only the low-order
bits of the result matter, and is a (minor) win since ash is a bit
more solid than lsh nowadays, and is a bit faster.
* lisp/calc/calc-ext.el (math-check-fixnum):
Prefer most-positive-fixnum to (lsh -1 -1).
* lisp/vc/vc-hg.el (vc-hg-state-fast): When testing fixnum width,
prefer (zerop (ash most-positive-fixnum -32)) to (zerop (lsh -1
32)) (Bug#32485#11).
* lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode):
Tighten sanity-check for bytecode overflow, by checking that the
result of (ash pc -8) is nonnegative. Formerly this check was not
needed since lsh was used and the number overflowed differently.
* lisp/net/dns.el (dns-write): Fix some obvious sign typos in
shift counts. Evidently this part of the code has never been
exercised.
* lisp/progmodes/hideif.el (hif-shiftleft, hif-shiftright):
* lisp/term/common-win.el (x-setup-function-keys):
Simplify.
* admin/unidata/unidata-gen.el, admin/unidata/uvs.el:
* doc/lispref/keymaps.texi, doc/lispref/syntax.texi:
* doc/misc/calc.texi, doc/misc/cl.texi, etc/NEWS.19:
* lisp/arc-mode.el, lisp/calc/calc-bin.el, lisp/calc/calc-comb.el:
* lisp/calc/calc-ext.el, lisp/calc/calc-math.el:
* lisp/cedet/semantic/wisent/comp.el, lisp/composite.el:
* lisp/disp-table.el, lisp/dos-fns.el, lisp/edmacro.el:
* lisp/emacs-lisp/bindat.el, lisp/emacs-lisp/byte-opt.el:
* lisp/emacs-lisp/bytecomp.el, lisp/emacs-lisp/cl-extra.el:
* lisp/erc/erc-dcc.el, lisp/facemenu.el, lisp/gnus/message.el:
* lisp/gnus/nndoc.el, lisp/gnus/nnmaildir.el, lisp/image.el:
* lisp/international/ccl.el, lisp/international/fontset.el:
* lisp/international/mule-cmds.el, lisp/international/mule.el:
* lisp/json.el, lisp/mail/binhex.el, lisp/mail/rmail.el:
* lisp/mail/uudecode.el, lisp/md4.el, lisp/net/dns.el:
* lisp/net/ntlm.el, lisp/net/sasl.el, lisp/net/socks.el:
* lisp/net/tramp.el, lisp/obsolete/levents.el:
* lisp/obsolete/pgg-parse.el, lisp/org/org.el:
* lisp/org/ox-publish.el, lisp/progmodes/cc-defs.el:
* lisp/progmodes/ebnf2ps.el, lisp/progmodes/hideif.el:
* lisp/ps-bdf.el, lisp/ps-print.el, lisp/simple.el:
* lisp/tar-mode.el, lisp/term/common-win.el:
* lisp/term/tty-colors.el, lisp/term/xterm.el, lisp/vc/vc-git.el:
* lisp/vc/vc-hg.el, lisp/x-dnd.el, test/src/data-tests.el:
Prefer ash to lsh when either will do.
2018-08-21 20:44:03 +00:00
|
|
|
(let ((face-id (if (consp glyph) (cdr glyph) (ash glyph -22))))
|
2007-02-14 11:28:40 +00:00
|
|
|
(and (> face-id 0)
|
2008-03-01 15:40:44 +00:00
|
|
|
(catch 'face
|
|
|
|
(dolist (face (face-list))
|
|
|
|
(when (eq (face-id face) face-id)
|
|
|
|
(throw 'face face)))))))
|
2007-02-14 11:28:40 +00:00
|
|
|
|
1993-05-25 06:21:35 +00:00
|
|
|
;;;###autoload
|
1999-10-21 06:30:07 +00:00
|
|
|
(defun standard-display-european (arg)
|
1999-06-04 18:42:20 +00:00
|
|
|
"Semi-obsolete way to toggle display of ISO 8859 European characters.
|
1999-01-19 03:00:26 +00:00
|
|
|
|
2009-08-29 02:25:29 +00:00
|
|
|
This function is semi-obsolete; you probably don't need it, or else you
|
|
|
|
probably should use `set-language-environment' or `set-locale-environment'.
|
1998-05-09 21:10:30 +00:00
|
|
|
|
2009-08-29 02:25:29 +00:00
|
|
|
This function enables European character display if ARG is positive,
|
|
|
|
disables it if negative. Otherwise, it toggles European character display.
|
1997-09-09 19:07:56 +00:00
|
|
|
|
1999-06-04 18:42:20 +00:00
|
|
|
When this mode is enabled, characters in the range of 160 to 255
|
|
|
|
display not as octal escapes, but as accented characters. Codes 146
|
|
|
|
and 160 display as apostrophe and space, even though they are not the
|
|
|
|
ASCII codes for apostrophe and space.
|
1997-08-01 01:22:16 +00:00
|
|
|
|
1999-06-04 18:42:20 +00:00
|
|
|
Enabling European character display with this command noninteractively
|
2009-08-29 02:25:29 +00:00
|
|
|
from Lisp code also selects Latin-1 as the language environment.
|
|
|
|
This provides increased compatibility for users who call this function
|
|
|
|
in `.emacs'."
|
1997-08-29 05:22:39 +00:00
|
|
|
|
1994-06-07 18:02:08 +00:00
|
|
|
(if (or (<= (prefix-numeric-value arg) 0)
|
1993-05-25 06:21:35 +00:00
|
|
|
(and (null arg)
|
1995-10-09 17:45:47 +00:00
|
|
|
(char-table-p standard-display-table)
|
1995-12-23 07:32:51 +00:00
|
|
|
;; Test 161, because 160 displays as a space.
|
2010-08-31 07:49:21 +00:00
|
|
|
(equal (aref standard-display-table
|
|
|
|
(unibyte-char-to-multibyte 161))
|
|
|
|
(vector (unibyte-char-to-multibyte 161)))))
|
1997-09-08 09:59:29 +00:00
|
|
|
(progn
|
2010-08-31 07:49:21 +00:00
|
|
|
(standard-display-default
|
|
|
|
(unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255))
|
2019-04-03 19:57:16 +00:00
|
|
|
(unless (display-graphic-p)
|
1999-06-04 18:42:20 +00:00
|
|
|
(and (terminal-coding-system)
|
|
|
|
(set-terminal-coding-system nil))))
|
2005-09-08 18:41:13 +00:00
|
|
|
|
|
|
|
(display-warning 'i18n
|
Top-level elisp files respect ‘text-quoting-style’
In top-level elisp files, use format-message in diagnostic formats,
so that they follow user preference as per ‘text-quoting-style’
rather than being hard-coded to quote `like this'.
* lisp/allout.el (allout-get-configvar-values):
* lisp/apropos.el (apropos-symbols-internal):
* lisp/dired-aux.el (dired-do-shell-command, dired-create-files)
(dired-do-create-files-regexp, dired-create-files-non-directory):
* lisp/dired-x.el (dired-do-run-mail):
* lisp/dired.el (dired-log, dired-dnd-handle-local-file):
* lisp/disp-table.el (standard-display-european):
* lisp/find-dired.el (find-dired):
* lisp/forms.el (forms-mode):
* lisp/ido.el (ido-buffer-internal):
* lisp/info.el (Info-index-next):
* lisp/outline.el (outline-invent-heading):
* lisp/printing.el (pr-ps-outfile-preprint, pr-i-ps-send):
* lisp/proced.el (proced-log):
* lisp/ps-print.el (ps-print-preprint, ps-get-size):
* lisp/recentf.el (recentf-open-files, recentf-save-list):
* lisp/savehist.el (savehist-save):
* lisp/server.el (server-ensure-safe-dir):
* lisp/ses.el (ses-rename-cell):
* lisp/simple.el (list-processes--refresh):
* lisp/startup.el (command-line):
* lisp/strokes.el (strokes-unset-last-stroke)
(strokes-execute-stroke):
Use format-message so that quotes are restyled.
* lisp/cus-edit.el (custom-raised-buttons, customize-browse):
Don’t quote ‘raised’.
* lisp/descr-text.el (describe-char):
* lisp/dirtrack.el (dirtrack-debug-message):
* lisp/hexl.el (hexl-insert-multibyte-char):
Apply substitute-command-keys to help string.
* lisp/wdired.el (wdired-do-renames, wdired-do-symlink-changes)
(wdired-do-perm-changes):
Let dired-log do the formatting.
2015-08-26 08:30:29 +00:00
|
|
|
(format-message
|
|
|
|
"`standard-display-european' is semi-obsolete; see its doc string for details")
|
2005-09-08 18:41:13 +00:00
|
|
|
:warning)
|
2001-12-02 07:51:49 +00:00
|
|
|
|
|
|
|
;; Switch to Latin-1 language environment
|
1998-04-30 03:18:48 +00:00
|
|
|
;; unless some other has been specified.
|
2001-12-02 07:51:49 +00:00
|
|
|
(if (equal current-language-environment "English")
|
|
|
|
(set-language-environment "latin-1"))
|
2019-04-03 19:57:16 +00:00
|
|
|
(unless (or noninteractive (display-graphic-p))
|
1999-10-21 06:30:07 +00:00
|
|
|
;; 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.
|
1997-09-13 19:05:54 +00:00
|
|
|
(set-terminal-coding-system
|
1999-10-21 06:30:07 +00:00
|
|
|
(let ((c (intern (downcase current-language-environment))))
|
|
|
|
(if (coding-system-p c) c 'latin-1))))
|
1998-04-30 03:18:48 +00:00
|
|
|
(standard-display-european-internal)))
|
1993-05-24 21:13:21 +00:00
|
|
|
|
1989-10-31 16:00:07 +00:00
|
|
|
(provide 'disp-table)
|
1992-05-30 23:54:21 +00:00
|
|
|
|
|
|
|
;;; disp-table.el ends here
|