* lisp/term/xterm.el: Fix xterm-paste handling for rxvt

* lisp/term/rxvt.el: Require term/xterm.
(rxvt-function-map): Use xterm-rxvt-function-map.
(rxvt-standard-colors): Move before first use.
(terminal-init-rxvt): Use xterm--push-map and xterm-register-default-colors.
(rxvt-rgb-convert-to-16bit, rxvt-register-default-colors): Remove.

* lisp/term/xterm.el (xterm-rxvt-function-map): New var.
Move shared bindings between rxvt and xterm to it.
(xterm-function-map): Use it.  Move the xterm-paste binding to
xterm-rxvt-function-map (bug#20444).
(xterm-standard-colors): Move before first use.
(xterm--push-map): New function.
(xterm-register-default-colors): Take standard colors as argument.
(terminal-init-xterm): Use it.  Adjust call to
xterm-register-default-colors.
This commit is contained in:
Stefan Monnier 2015-05-11 17:23:36 -04:00
parent 3c5cc185df
commit 0a21b26c58
2 changed files with 92 additions and 198 deletions

View file

@ -24,36 +24,21 @@
;;; Code:
(require 'term/xterm)
(defvar rxvt-function-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map xterm-rxvt-function-map)
;; Set up input-decode-map entries that termcap and terminfo don't know.
(define-key map "\e[A" [up])
(define-key map "\e[B" [down])
(define-key map "\e[C" [right])
(define-key map "\e[D" [left])
(define-key map "\e[2~" [insert])
(define-key map "\e[3~" [delete])
(define-key map "\e[4~" [select])
(define-key map "\e[5~" [prior])
(define-key map "\e[6~" [next])
(define-key map "\e[7~" [home])
(define-key map "\e[8~" [end])
(define-key map "\e[11~" [f1])
(define-key map "\e[12~" [f2])
(define-key map "\e[13~" [f3])
(define-key map "\e[14~" [f4])
(define-key map "\e[15~" [f5])
(define-key map "\e[17~" [f6])
(define-key map "\e[18~" [f7])
(define-key map "\e[19~" [f8])
(define-key map "\e[20~" [f9])
(define-key map "\e[21~" [f10])
;; The strings emitted by f11 and f12 are the same as the strings
;; emitted by S-f1 and S-f2, so don't define f11 and f12.
;; (define-key rxvt-function-map "\e[23~" [f11])
;; (define-key rxvt-function-map "\e[24~" [f12])
(define-key map "\e[29~" [print])
(define-key map "\e[23~" [S-f1])
(define-key map "\e[24~" [S-f2])
(define-key map "\e[11^" [C-f1])
(define-key map "\e[12^" [C-f2])
@ -66,8 +51,6 @@
(define-key map "\e[20^" [C-f9])
(define-key map "\e[21^" [C-f10])
(define-key map "\e[23~" [S-f1])
(define-key map "\e[24~" [S-f2])
(define-key map "\e[25~" [S-f3])
(define-key map "\e[26~" [S-f4])
(define-key map "\e[28~" [S-f5])
@ -99,7 +82,6 @@
(define-key map "\eOa" [C-up])
(define-key map "\eOb" [C-down])
(define-key map "\e[2;2~" [S-insert])
(define-key map "\e[3$" [S-delete])
(define-key map "\e[5$" [S-prior])
(define-key map "\e[6$" [S-next])
@ -157,26 +139,6 @@
map)
"Keymap of possible alternative meanings for some keys.")
(defun terminal-init-rxvt ()
"Terminal initialization function for rxvt."
(let ((map (copy-keymap rxvt-alternatives-map)))
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map))
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
;; made in the init file.
(let ((m (copy-keymap rxvt-function-map)))
(set-keymap-parent m (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map m))
;; Initialize colors and background mode.
(rxvt-register-default-colors)
(rxvt-set-background-mode)
;; This recomputes all the default faces given the colors we've just set up.
(tty-set-up-initial-frame-faces))
;; Set up colors, for those versions of rxvt that support it.
(defvar rxvt-standard-colors
;; The names of the colors in the comments taken from the rxvt.1 man
@ -199,93 +161,17 @@
("brightwhite" 15 (255 255 255))) ; white
"Names of 16 standard rxvt colors, their numbers, and RGB values.")
(defun rxvt-rgb-convert-to-16bit (prim)
"Convert an 8-bit primary color value PRIM to a corresponding 16-bit value."
(logior prim (lsh prim 8)))
(defun terminal-init-rxvt ()
"Terminal initialization function for rxvt."
(defun rxvt-register-default-colors ()
"Register the default set of colors for rxvt or compatible emulator.
(xterm--push-map rxvt-alternatives-map local-function-key-map)
(xterm--push-map rxvt-function-map input-decode-map)
This function registers the number of colors returned by `display-color-cells'
for the currently selected frame."
(let* ((ncolors (display-color-cells))
(colors rxvt-standard-colors)
(color (car colors)))
(if (> ncolors 0)
;; Clear the 8 default tty colors registered by startup.el
(tty-color-clear))
;; Only register as many colors as are supported by the display.
(while (and (> ncolors 0) colors)
(tty-color-define (car color) (cadr color)
(mapcar 'rxvt-rgb-convert-to-16bit
(car (cddr color))))
(setq colors (cdr colors)
color (car colors)
ncolors (1- ncolors)))
(when (> ncolors 0)
(cond
((= ncolors 240) ; 256-color rxvt
;; 216 non-gray colors first
(let ((r 0) (g 0) (b 0))
(while (> ncolors 24)
;; This and other formulas taken from 256colres.pl and
;; 88colres.pl in the xterm distribution.
(tty-color-define (format "color-%d" (- 256 ncolors))
(- 256 ncolors)
(mapcar 'rxvt-rgb-convert-to-16bit
(list (if (zerop r) 0 (+ (* r 40) 55))
(if (zerop g) 0 (+ (* g 40) 55))
(if (zerop b) 0 (+ (* b 40) 55)))))
(setq b (1+ b))
(if (> b 5)
(setq g (1+ g)
b 0))
(if (> g 5)
(setq r (1+ r)
g 0))
(setq ncolors (1- ncolors))))
;; Now the 24 gray colors
(while (> ncolors 0)
(setq color (rxvt-rgb-convert-to-16bit (+ 8 (* (- 24 ncolors) 10))))
(tty-color-define (format "color-%d" (- 256 ncolors))
(- 256 ncolors)
(list color color color))
(setq ncolors (1- ncolors))))
((= ncolors 72) ; rxvt-unicode
;; 64 non-gray colors
(let ((levels '(0 139 205 255))
(r 0) (g 0) (b 0))
(while (> ncolors 8)
(tty-color-define (format "color-%d" (- 88 ncolors))
(- 88 ncolors)
(mapcar 'rxvt-rgb-convert-to-16bit
(list (nth r levels)
(nth g levels)
(nth b levels))))
(setq b (1+ b))
(if (> b 3)
(setq g (1+ g)
b 0))
(if (> g 3)
(setq r (1+ r)
g 0))
(setq ncolors (1- ncolors))))
;; Now the 8 gray colors
(while (> ncolors 0)
(setq color (rxvt-rgb-convert-to-16bit
(floor
(if (= ncolors 8)
46.36363636
(+ (* (- 8 ncolors) 23.18181818) 69.54545454)))))
(tty-color-define (format "color-%d" (- 88 ncolors))
(- 88 ncolors)
(list color color color))
(setq ncolors (1- ncolors))))
(t (error "Unsupported number of rxvt colors (%d)" (+ 16 ncolors)))))
;; Modifying color mappings means realized faces don't use the
;; right colors, so clear them.
(clear-face-cache)))
;; Initialize colors and background mode.
(xterm-register-default-colors rxvt-standard-colors)
(rxvt-set-background-mode)
;; This recomputes all the default faces given the colors we've just set up.
(tty-set-up-initial-frame-faces))
;; rxvt puts the default colors into an environment variable
;; COLORFGBG. We use this to set the background mode in a more

View file

@ -95,20 +95,50 @@ string bytes that can be copied is 3/4 of this value."
(define-key global-map [xterm-paste] #'xterm-paste)
(defvar xterm-function-map
(defvar xterm-rxvt-function-map
(let ((map (make-sparse-keymap)))
(define-key map "\e[2~" [insert])
(define-key map "\e[3~" [delete])
(define-key map "\e[4~" [select])
(define-key map "\e[5~" [prior])
(define-key map "\e[6~" [next])
;; xterm from X.org 6.8.2 uses these key definitions.
(define-key map "\eOP" [f1])
(define-key map "\eOQ" [f2])
(define-key map "\eOR" [f3])
(define-key map "\eOS" [f4])
(define-key map "\e[15~" [f5])
(define-key map "\e[17~" [f6])
(define-key map "\e[18~" [f7])
(define-key map "\e[19~" [f8])
(define-key map "\e[20~" [f9])
(define-key map "\e[21~" [f10])
(define-key map "\e[2;2~" [S-insert])
;; Other versions of xterm might emit these.
(define-key map "\e[A" [up])
(define-key map "\e[B" [down])
(define-key map "\e[C" [right])
(define-key map "\e[D" [left])
(define-key map "\e[11~" [f1])
(define-key map "\e[12~" [f2])
(define-key map "\e[13~" [f3])
(define-key map "\e[14~" [f4])
;; Recognize the start of a bracketed paste sequence. The handler
;; internally recognizes the end.
(define-key map "\e[200~" [xterm-paste])
map)
"Keymap of escape sequences, shared between xterm and rxvt support.")
(defvar xterm-function-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map xterm-rxvt-function-map)
;; xterm from X.org 6.8.2 uses these key definitions.
(define-key map "\eOP" [f1])
(define-key map "\eOQ" [f2])
(define-key map "\eOR" [f3])
(define-key map "\eOS" [f4])
(define-key map "\e[23~" [f11])
(define-key map "\e[24~" [f12])
@ -237,12 +267,6 @@ string bytes that can be copied is 3/4 of this value."
(define-key map "\e[1;3F" [M-end])
(define-key map "\e[1;3H" [M-home])
(define-key map "\e[2~" [insert])
(define-key map "\e[3~" [delete])
(define-key map "\e[5~" [prior])
(define-key map "\e[6~" [next])
(define-key map "\e[2;2~" [S-insert])
(define-key map "\e[3;2~" [S-delete])
(define-key map "\e[5;2~" [S-prior])
(define-key map "\e[6;2~" [S-next])
@ -277,7 +301,6 @@ string bytes that can be copied is 3/4 of this value."
(define-key map "\e[5;3~" [M-prior])
(define-key map "\e[6;3~" [M-next])
(define-key map "\e[4~" [select])
(define-key map "\e[29~" [print])
(define-key map "\eOj" [kp-multiply])
@ -482,10 +505,6 @@ string bytes that can be copied is 3/4 of this value."
(format "\e[%d;%du" (nth 1 bind) (nth 0 bind)) (nth 2 bind)))
;; Other versions of xterm might emit these.
(define-key map "\e[A" [up])
(define-key map "\e[B" [down])
(define-key map "\e[C" [right])
(define-key map "\e[D" [left])
(define-key map "\e[1~" [home])
(define-key map "\eO2A" [S-up])
@ -502,15 +521,6 @@ string bytes that can be copied is 3/4 of this value."
(define-key map "\eO5F" [C-end])
(define-key map "\eO5H" [C-home])
(define-key map "\e[11~" [f1])
(define-key map "\e[12~" [f2])
(define-key map "\e[13~" [f3])
(define-key map "\e[14~" [f4])
;; Recognize the start of a bracketed paste sequence. The handler
;; internally recognizes the end.
(define-key map "\e[200~" [xterm-paste])
map)
"Function key map overrides for xterm.")
@ -580,6 +590,29 @@ string bytes that can be copied is 3/4 of this value."
map)
"Keymap of possible alternative meanings for some keys.")
;; Set up colors, for those versions of xterm that support it.
(defvar xterm-standard-colors
;; The names in the comments taken from XTerm-col.ad in the xterm
;; distribution, see ftp://dickey.his.com/xterm/. RGB values are
;; from rgb.txt.
'(("black" 0 ( 0 0 0)) ; black
("red" 1 (205 0 0)) ; red3
("green" 2 ( 0 205 0)) ; green3
("yellow" 3 (205 205 0)) ; yellow3
("blue" 4 ( 0 0 238)) ; blue2
("magenta" 5 (205 0 205)) ; magenta3
("cyan" 6 ( 0 205 205)) ; cyan3
("white" 7 (229 229 229)) ; gray90
("brightblack" 8 (127 127 127)) ; gray50
("brightred" 9 (255 0 0)) ; red
("brightgreen" 10 ( 0 255 0)) ; green
("brightyellow" 11 (255 255 0)) ; yellow
("brightblue" 12 (92 92 255)) ; rgb:5c/5c/ff
("brightmagenta" 13 (255 0 255)) ; magenta
("brightcyan" 14 ( 0 255 255)) ; cyan
("brightwhite" 15 (255 255 255))) ; white
"Names of 16 standard xterm/aixterm colors, their numbers, and RGB values.")
(defun xterm--report-background-handler ()
(let ((str "")
chr)
@ -687,6 +720,14 @@ We run the first FUNCTION whose STRING matches the input events."
(push (aref (car handler) (setq i (1- i)))
unread-command-events)))))))
(defun xterm--push-map (map basemap)
;; Use inheritance to let the main keymaps override those defaults.
;; This way we don't override terminfo-derived settings or settings
;; made in the init file.
(set-keymap-parent
basemap
(make-composed-keymap map (keymap-parent basemap))))
(defun terminal-init-xterm ()
"Terminal initialization function for xterm."
;; rxvt terminals sometimes set the TERM variable to "xterm", but
@ -696,19 +737,10 @@ We run the first FUNCTION whose STRING matches the input events."
(string-match "\\`rxvt" (getenv "COLORTERM" (selected-frame))))
(tty-run-terminal-initialization (selected-frame) "rxvt")
(let ((map (copy-keymap xterm-alternatives-map)))
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map))
(xterm--push-map xterm-alternatives-map local-function-key-map)
(xterm--push-map xterm-function-map input-decode-map))
(let ((map (copy-keymap xterm-function-map)))
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
;; made in the init file.
(set-keymap-parent map (keymap-parent input-decode-map))
(set-keymap-parent input-decode-map map)))
(xterm-register-default-colors)
(xterm-register-default-colors xterm-standard-colors)
(tty-set-up-initial-frame-faces)
(if (eq xterm-extra-capabilities 'check)
@ -807,43 +839,19 @@ hitting screen's max DCS length."
"\a"
(when screen "\e\\"))))))))
;; Set up colors, for those versions of xterm that support it.
(defvar xterm-standard-colors
;; The names in the comments taken from XTerm-col.ad in the xterm
;; distribution, see ftp://dickey.his.com/xterm/. RGB values are
;; from rgb.txt.
'(("black" 0 ( 0 0 0)) ; black
("red" 1 (205 0 0)) ; red3
("green" 2 ( 0 205 0)) ; green3
("yellow" 3 (205 205 0)) ; yellow3
("blue" 4 ( 0 0 238)) ; blue2
("magenta" 5 (205 0 205)) ; magenta3
("cyan" 6 ( 0 205 205)) ; cyan3
("white" 7 (229 229 229)) ; gray90
("brightblack" 8 (127 127 127)) ; gray50
("brightred" 9 (255 0 0)) ; red
("brightgreen" 10 ( 0 255 0)) ; green
("brightyellow" 11 (255 255 0)) ; yellow
("brightblue" 12 (92 92 255)) ; rgb:5c/5c/ff
("brightmagenta" 13 (255 0 255)) ; magenta
("brightcyan" 14 ( 0 255 255)) ; cyan
("brightwhite" 15 (255 255 255))) ; white
"Names of 16 standard xterm/aixterm colors, their numbers, and RGB values.")
(defun xterm-rgb-convert-to-16bit (prim)
"Convert an 8-bit primary color value PRIM to a corresponding 16-bit value."
(logior prim (lsh prim 8)))
(defun xterm-register-default-colors ()
(defun xterm-register-default-colors (colors)
"Register the default set of colors for xterm or compatible emulator.
This function registers the number of colors returned by `display-color-cells'
for the currently selected frame. The first 16 colors are taken from
`xterm-standard-colors', which see, while the rest are computed assuming
for the currently selected frame. The first (16) colors are taken from
COLORS, which see, while the rest are computed assuming
either the 88- or 256-color standard color scheme supported by latest
versions of xterm."
(let* ((ncolors (display-color-cells (selected-frame)))
(colors xterm-standard-colors)
(let* ((ncolors (display-color-cells))
(color (car colors)))
(if (> ncolors 0)
;; Clear the 8 default tty colors registered by startup.el
@ -851,12 +859,12 @@ versions of xterm."
;; Only register as many colors as are supported by the display.
(while (and (> ncolors 0) colors)
(tty-color-define (car color) (cadr color)
(mapcar 'xterm-rgb-convert-to-16bit
(mapcar #'xterm-rgb-convert-to-16bit
(car (cddr color))))
(setq colors (cdr colors)
color (car colors)
ncolors (1- ncolors)))
;; We've exhausted the colors from `xterm-standard-colors'. If there
;; We've exhausted the colors from `colors'. If there
;; are more colors to support, compute them now.
(when (> ncolors 0)
(cond
@ -868,7 +876,7 @@ versions of xterm."
;; 88colres.pl in the xterm distribution.
(tty-color-define (format "color-%d" (- 256 ncolors))
(- 256 ncolors)
(mapcar 'xterm-rgb-convert-to-16bit
(mapcar #'xterm-rgb-convert-to-16bit
(list (if (zerop r) 0 (+ (* r 40) 55))
(if (zerop g) 0 (+ (* g 40) 55))
(if (zerop b) 0 (+ (* b 40) 55)))))
@ -895,7 +903,7 @@ versions of xterm."
(while (> ncolors 8)
(tty-color-define (format "color-%d" (- 88 ncolors))
(- 88 ncolors)
(mapcar 'xterm-rgb-convert-to-16bit
(mapcar #'xterm-rgb-convert-to-16bit
(list (nth r levels)
(nth g levels)
(nth b levels))))