diff options
Diffstat (limited to 'lisp/term')
33 files changed, 1906 insertions, 2418 deletions
diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 06ae6d42583..8e418ecd326 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -29,34 +29,35 @@ ;;; Code: -(if (boundp 'AT386-keypad-map) - nil - ;; The terminal initialization should already have set up some keys - (setq AT386-keypad-map (lookup-key function-key-map "\e[")) - (if (not (keymapp AT386-keypad-map)) - (error "What? Your AT386 termcap/terminfo has no keycaps in it")) - - ;; Equivalents of these are set up automatically by termcap/terminfo - ;; (define-key AT386-keypad-map "A" [up]) - ;; (define-key AT386-keypad-map "B" [down]) - ;; (define-key AT386-keypad-map "C" [right]) - ;; (define-key AT386-keypad-map "D" [left]) - - ;; These would be set up by terminfo, but not termcap - (define-key AT386-keypad-map "H" [home]) - (define-key AT386-keypad-map "Y" [end]) - (define-key AT386-keypad-map "U" [next]) ;; PgDn - (define-key AT386-keypad-map "V" [prior]) ;; PgUp - (define-key AT386-keypad-map "@" [insert]) ;; Ins key - - ;; These are not normally set up by either - (define-key AT386-keypad-map "G" [kp-5]) ;; Unlabeled center key - (define-key AT386-keypad-map "S" [kp-subtract]) - (define-key AT386-keypad-map "T" [kp-add]) - - ;; Arrange for the ALT key to be equivalent to ESC - (define-key function-key-map "\eN" [27]) ; ALT map - ) - -;;; arch-tag: abec1b03-582f-49f8-b8cb-e2fd52ea4bd7 +(defun terminal-init-AT386 () + "Terminal initialization function for AT386." + (let ((AT386-keypad-map (lookup-key input-decode-map "\e["))) + ;; The terminal initialization should already have set up some keys + (if (not (keymapp AT386-keypad-map)) + (error "What? Your AT386 termcap/terminfo has no keycaps in it")) + + ;; Equivalents of these are set up automatically by termcap/terminfo + ;; (define-key AT386-keypad-map "A" [up]) + ;; (define-key AT386-keypad-map "B" [down]) + ;; (define-key AT386-keypad-map "C" [right]) + ;; (define-key AT386-keypad-map "D" [left]) + + ;; These would be set up by terminfo, but not termcap + (define-key AT386-keypad-map "H" [home]) + (define-key AT386-keypad-map "Y" [end]) + (define-key AT386-keypad-map "U" [next]) ;; PgDn + (define-key AT386-keypad-map "V" [prior]) ;; PgUp + (define-key AT386-keypad-map "@" [insert]) ;; Ins key + + ;; These are not normally set up by either + (define-key AT386-keypad-map "G" [kp-5]) ;; Unlabeled center key + (define-key AT386-keypad-map "S" [kp-subtract]) + (define-key AT386-keypad-map "T" [kp-add]) + + ;; Arrange for the ALT key to be equivalent to ESC + (define-key input-decode-map "\eN" [ALT]) + (define-key local-function-key-map [ALT] [27]) + )) + +;; arch-tag: abec1b03-582f-49f8-b8cb-e2fd52ea4bd7 ;;; AT386.el ends here diff --git a/lisp/term/README b/lisp/term/README index 1ee89f58112..543bd352c05 100644 --- a/lisp/term/README +++ b/lisp/term/README @@ -6,19 +6,43 @@ See the end of the file for license conditions. This directory contains files of elisp that customize Emacs for certain terminal types. - When Emacs starts, it checks the TERM environment variable to see what type -of terminal the user is running on, checks for an elisp file named -"term/${TERM}.el", and if one exists, loads it. If that doesn't yield a file -that exists, the last hyphen and what follows it is stripped. If that doesn't -yield a file that exists, the previous hyphen is stripped, and so on until all -hyphens are gone. For example, if the terminal type is `aaa-48-foo', Emacs -will try first `term/aaa-48-foo.el', then `term/aaa-48.el' and finally -`term/aaa.el'. Each terminal specific file should contain a function -named terminal-init-TERMINALNAME (eg terminal-init-aaa-48 for -term/aaa-48.el) that Emacs will call in order to initialize the -terminal. The terminal files should not contain any top level forms -that are executed when the file is loaded, all the initialization -actions are performed by the terminal-init-TERMINALNAME functions. + When Emacs opens a new terminal, it checks the TERM environment variable to +see what type of terminal the user is running on, searches for an elisp file +named "term/${TERM}.el", and if one exists, loads it. If Emacs finds no +suitable file, then it strips the last hyphen and what follows it from TERM, +and tries again. If that still doesn't yield a file, then the previous hyphen +is stripped, and so on until all hyphens are gone. For example, if the +terminal type is `aaa-48-foo', Emacs will try first `term/aaa-48-foo.el', then +`term/aaa-48.el' and finally `term/aaa.el'. Emacs stops searching at the +first file found, and will not load more than one file for any terminal. Note +that it is not an error if Emacs is unable to find a terminal initialization +file; in that case, it will simply proceed with the next step without loading +any files. + + Once the file has been loaded (or the search failed), Emacs tries to call a +function named `terminal-init-TERMINALNAME' (eg `terminal-init-aaa-48' for the +`aaa-48' terminal) in order to initialize the terminal. Once again, if the +function is not found, Emacs strips the last component of the name and tries +again using the shorter name. This search is independent of the previous file +search, so that you can have terminal initialization functions for a family of +terminals collected in a single file named after the family name, and users +may put terminal initialization functions directly in their .emacs files. + + Note that an individual terminal file is loaded only once in an Emacs +session; if the same terminal type is opened again, Emacs will simply call the +initialization function without reloading the file. Therefore, all the actual +initialization actions should be collected in terminal-init-* functions; the +file should not contain any top-level form that is not a function or variable +declaration. Simply loading the file should not have any side effect. + + Similarly, the terminal initialization function is called only once on any +given terminal, when the first frame is created on it. The function is not +called for subsequent frames on the same terminal. Therefore, terminal-init-* +functions should only modify terminal-local variables (such as +`local-function-key-map') and terminal parameters. For example, it is not +correct to modify frame parameters, since the modifications will only be +applied for the first frame opened on the terminal. + When writing terminal packages, there are some things it is good to keep in mind. diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el index 749ff85a0a6..c47de919b0c 100644 --- a/lisp/term/apollo.el +++ b/lisp/term/apollo.el @@ -1,7 +1,7 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-apollo () - "Terminal initialization function for apollo." - (load "term/vt100" nil t)) + "Terminal initialization function for apollo." + (tty-run-terminal-initialization (selected-frame) "vt100")) ;;; arch-tag: c72f446f-e6b7-4749-90a4-bd68632adacf ;;; apollo.el ends here diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el index 82401f7bf71..974476f6798 100644 --- a/lisp/term/bobcat.el +++ b/lisp/term/bobcat.el @@ -1,7 +1,7 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-bobcat () - "Terminal initialization function for bobcat." + "Terminal initialization function for bobcat." ;; HP terminals usually encourage using ^H as the rubout character (keyboard-translate ?\177 ?\^h) (keyboard-translate ?\^h ?\177)) diff --git a/lisp/term/cygwin.el b/lisp/term/cygwin.el index 3bdd5d3aa05..df857ba6625 100644 --- a/lisp/term/cygwin.el +++ b/lisp/term/cygwin.el @@ -3,7 +3,7 @@ ;;; The Cygwin terminal can't really display underlines. (defun terminal-init-cygwin () - "Terminal initialization function for cygwin." + "Terminal initialization function for cygwin." (tty-no-underline)) ;; arch-tag: ca81ce67-3c41-4883-a29b-4c3d64a21191 diff --git a/lisp/term/internal.el b/lisp/term/internal.el index c990b0949c2..0c7d9446992 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -29,20 +29,20 @@ ;; --------------------------------------------------------------------------- ;; keyboard setup -- that's simple! (set-input-mode nil nil 0) -(define-key function-key-map [backspace] "\177") ; Normal behaviour for BS -(define-key function-key-map [delete] "\C-d") ; ... and Delete -(define-key function-key-map [tab] [?\t]) -(define-key function-key-map [linefeed] [?\n]) -(define-key function-key-map [clear] [11]) -(define-key function-key-map [return] [13]) -(define-key function-key-map [escape] [?\e]) -(define-key function-key-map [M-backspace] [?\M-\d]) -(define-key function-key-map [M-delete] [?\M-d]) -(define-key function-key-map [M-tab] [?\M-\t]) -(define-key function-key-map [M-linefeed] [?\M-\n]) -(define-key function-key-map [M-clear] [?\M-\013]) -(define-key function-key-map [M-return] [?\M-\015]) -(define-key function-key-map [M-escape] [?\M-\e]) +(define-key local-function-key-map [backspace] "\177") ; Normal behaviour for BS +(define-key local-function-key-map [delete] "\C-d") ; ... and Delete +(define-key local-function-key-map [tab] [?\t]) +(define-key local-function-key-map [linefeed] [?\n]) +(define-key local-function-key-map [clear] [11]) +(define-key local-function-key-map [return] [13]) +(define-key local-function-key-map [escape] [?\e]) +(define-key local-function-key-map [M-backspace] [?\M-\d]) +(define-key local-function-key-map [M-delete] [?\M-d]) +(define-key local-function-key-map [M-tab] [?\M-\t]) +(define-key local-function-key-map [M-linefeed] [?\M-\n]) +(define-key local-function-key-map [M-clear] [?\M-\013]) +(define-key local-function-key-map [M-return] [?\M-\015]) +(define-key local-function-key-map [M-escape] [?\M-\e])) (put 'backspace 'ascii-character 127) (put 'delete 'ascii-character 127) (put 'tab 'ascii-character ?\t) diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index 0de976c976f..7089348ed13 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -26,306 +26,309 @@ ;;; Code: -(defun iris-ansi-initialize-terminal () - "Terminal initialization function for iris-ansi." - (define-key function-key-map "\e[120q" [S-escape]) - (define-key function-key-map "\e[121q" [C-escape]) +(defvar iris-function-map + (let ((map (make-sparse-keymap))) - (define-key function-key-map "\e[001q" [f1]) - (define-key function-key-map "\e[013q" [S-f1]) - (define-key function-key-map "\e[025q" [C-f1]) + (define-key map "\e[120q" [S-escape]) + (define-key map "\e[121q" [C-escape]) + (define-key map "\e[001q" [f1]) + (define-key map "\e[013q" [S-f1]) + (define-key map "\e[025q" [C-f1]) - (define-key function-key-map "\e[002q" [f2]) - (define-key function-key-map "\e[014q" [S-f2]) - (define-key function-key-map "\e[026q" [C-f2]) - (define-key function-key-map "\e[038q" [M-f2]) - (define-key function-key-map "\e[003q" [f3]) - (define-key function-key-map "\e[015q" [S-f3]) - (define-key function-key-map "\e[027q" [C-f3]) + (define-key map "\e[002q" [f2]) + (define-key map "\e[014q" [S-f2]) + (define-key map "\e[026q" [C-f2]) + (define-key map "\e[038q" [M-f2]) + (define-key map "\e[003q" [f3]) + (define-key map "\e[015q" [S-f3]) + (define-key map "\e[027q" [C-f3]) - (define-key function-key-map "\e[004q" [f4]) - (define-key function-key-map "\e[016q" [S-f4]) - (define-key function-key-map "\e[028q" [C-f4]) + (define-key map "\e[004q" [f4]) + (define-key map "\e[016q" [S-f4]) + (define-key map "\e[028q" [C-f4]) - (define-key function-key-map "\e[005q" [f5]) - (define-key function-key-map "\e[017q" [S-f5]) - (define-key function-key-map "\e[029q" [C-f5]) + (define-key map "\e[005q" [f5]) + (define-key map "\e[017q" [S-f5]) + (define-key map "\e[029q" [C-f5]) - (define-key function-key-map "\e[006q" [f6]) - (define-key function-key-map "\e[018q" [S-f6]) - (define-key function-key-map "\e[030q" [C-f6]) + (define-key map "\e[006q" [f6]) + (define-key map "\e[018q" [S-f6]) + (define-key map "\e[030q" [C-f6]) - (define-key function-key-map "\e[007q" [f7]) - (define-key function-key-map "\e[019q" [S-f7]) - (define-key function-key-map "\e[031q" [C-f7]) + (define-key map "\e[007q" [f7]) + (define-key map "\e[019q" [S-f7]) + (define-key map "\e[031q" [C-f7]) - (define-key function-key-map "\e[008q" [f8]) - (define-key function-key-map "\e[020q" [S-f8]) - (define-key function-key-map "\e[032q" [C-f8]) + (define-key map "\e[008q" [f8]) + (define-key map "\e[020q" [S-f8]) + (define-key map "\e[032q" [C-f8]) - (define-key function-key-map "\e[009q" [f9]) - (define-key function-key-map "\e[021q" [S-f9]) - (define-key function-key-map "\e[033q" [C-f9]) + (define-key map "\e[009q" [f9]) + (define-key map "\e[021q" [S-f9]) + (define-key map "\e[033q" [C-f9]) - (define-key function-key-map "\e[010q" [f10]) - (define-key function-key-map "\e[022q" [S-f10]) - (define-key function-key-map "\e[034q" [C-f10]) + (define-key map "\e[010q" [f10]) + (define-key map "\e[022q" [S-f10]) + (define-key map "\e[034q" [C-f10]) - (define-key function-key-map "\e[011q" [f11]) - (define-key function-key-map "\e[023q" [S-f11]) - (define-key function-key-map "\e[035q" [C-f11]) - (define-key function-key-map "\e[047q" [M-f11]) - (define-key function-key-map "\e[012q" [f12]) - (define-key function-key-map "\e[024q" [S-f12]) - (define-key function-key-map "\e[036q" [C-f12]) - (define-key function-key-map "\e[048q" [M-f12]) + (define-key map "\e[011q" [f11]) + (define-key map "\e[023q" [S-f11]) + (define-key map "\e[035q" [C-f11]) + (define-key map "\e[047q" [M-f11]) + (define-key map "\e[012q" [f12]) + (define-key map "\e[024q" [S-f12]) + (define-key map "\e[036q" [C-f12]) + (define-key map "\e[048q" [M-f12]) - (define-key function-key-map "\e[057q" [?\C-`]) - (define-key function-key-map "\e[115q" [?\M-`]) - (define-key function-key-map "\e[049q" [?\C-1]) - (define-key function-key-map "\e[058q" [?\M-1]) + (define-key map "\e[057q" [?\C-`]) + (define-key map "\e[115q" [?\M-`]) + (define-key map "\e[049q" [?\C-1]) + (define-key map "\e[058q" [?\M-1]) - (define-key function-key-map "\e[059q" [?\M-2]) - (define-key function-key-map "\e[050q" [?\C-3]) - (define-key function-key-map "\e[060q" [?\M-3]) + (define-key map "\e[059q" [?\M-2]) - (define-key function-key-map "\e[051q" [?\C-4]) - (define-key function-key-map "\e[061q" [?\M-4]) + (define-key map "\e[050q" [?\C-3]) + (define-key map "\e[060q" [?\M-3]) - (define-key function-key-map "\e[052q" [?\C-5]) - (define-key function-key-map "\e[062q" [?\M-5]) + (define-key map "\e[051q" [?\C-4]) + (define-key map "\e[061q" [?\M-4]) + (define-key map "\e[052q" [?\C-5]) + (define-key map "\e[062q" [?\M-5]) - (define-key function-key-map "\e[063q" [?\M-6]) - (define-key function-key-map "\e[053q" [?\C-7]) - (define-key function-key-map "\e[064q" [?\M-7]) + (define-key map "\e[063q" [?\M-6]) - (define-key function-key-map "\e[054q" [?\C-8]) - (define-key function-key-map "\e[065q" [?\M-8]) + (define-key map "\e[053q" [?\C-7]) + (define-key map "\e[064q" [?\M-7]) - (define-key function-key-map "\e[055q" [?\C-9]) - (define-key function-key-map "\e[066q" [?\M-9]) + (define-key map "\e[054q" [?\C-8]) + (define-key map "\e[065q" [?\M-8]) - (define-key function-key-map "\e[056q" [?\C-0]) - (define-key function-key-map "\e[067q" [?\M-0]) + (define-key map "\e[055q" [?\C-9]) + (define-key map "\e[066q" [?\M-9]) - (define-key function-key-map "\e[068q" [?\M--]) + (define-key map "\e[056q" [?\C-0]) + (define-key map "\e[067q" [?\M-0]) - (define-key function-key-map "\e[069q" [?\C-=]) - (define-key function-key-map "\e[070q" [?\M-=]) + (define-key map "\e[068q" [?\M--]) - ;; I don't know what to do with those. - ;;(define-key function-key-map "^H" [<del>]) - ;;(define-key function-key-map "^H" [S-<del>]) - ;;(define-key function-key-map "\177" [C-<del>]) - ;;(define-key function-key-map "\e[071q" [M-<del>]) + (define-key map "\e[069q" [?\C-=]) + (define-key map "\e[070q" [?\M-=]) - (define-key function-key-map "\e[Z" [?\S-\t]) - (define-key function-key-map "\e[072q" [?\C-\t]) - ;; This only works if you remove the M-TAB keybing from the system.4Dwmrc - ;; our your ~/.4Dwmrc, if you use the 4Dwm window manager. - (define-key function-key-map "\e[073q" [?\M-\t]) + ;; I don't know what to do with those. + ;;(define-key map "^H" [<del>]) + ;;(define-key map "^H" [S-<del>]) + ;;(define-key map "\177" [C-<del>]) + ;;(define-key map "\e[071q" [M-<del>]) - (define-key function-key-map "\e[074q" [?\M-q]) + (define-key map "\e[Z" [?\S-\t]) + (define-key map "\e[072q" [?\C-\t]) + ;; This only works if you remove the M-TAB keybing from the system.4Dwmrc + ;; our your ~/.4Dwmrc, if you use the 4Dwm window manager. + (define-key map "\e[073q" [?\M-\t]) - (define-key function-key-map "\e[075q" [?\M-w]) + (define-key map "\e[074q" [?\M-q]) - (define-key function-key-map "\e[076q" [?\M-e]) + (define-key map "\e[075q" [?\M-w]) - (define-key function-key-map "\e[077q" [?\M-r]) + (define-key map "\e[076q" [?\M-e]) - (define-key function-key-map "\e[078q" [?\M-t]) + (define-key map "\e[077q" [?\M-r]) - (define-key function-key-map "\e[079q" [?\M-y]) + (define-key map "\e[078q" [?\M-t]) - (define-key function-key-map "\e[080q" [?\M-u]) + (define-key map "\e[079q" [?\M-y]) - (define-key function-key-map "\e[081q" [?\M-i]) + (define-key map "\e[080q" [?\M-u]) - (define-key function-key-map "\e[082q" [?\M-o]) + (define-key map "\e[081q" [?\M-i]) - (define-key function-key-map "\e[083q" [?\M-p]) + (define-key map "\e[082q" [?\M-o]) - (define-key function-key-map "\e[084q" [?\M-\[]) + (define-key map "\e[083q" [?\M-p]) - (define-key function-key-map "\e[085q" [?\M-\]]) + (define-key map "\e[084q" [?\M-\[]) - (define-key function-key-map "\e[086q" [?\M-\\]) + (define-key map "\e[085q" [?\M-\]]) - (define-key function-key-map "\e[087q" [?\M-a]) + (define-key map "\e[086q" [?\M-\\]) - (define-key function-key-map "\e[088q" [?\M-s]) + (define-key map "\e[087q" [?\M-a]) - (define-key function-key-map "\e[089q" [?\M-d]) + (define-key map "\e[088q" [?\M-s]) - (define-key function-key-map "\e[090q" [?\M-f]) + (define-key map "\e[089q" [?\M-d]) - (define-key function-key-map "\e[091q" [?\M-g]) + (define-key map "\e[090q" [?\M-f]) - (define-key function-key-map "\e[092q" [?\M-h]) + (define-key map "\e[091q" [?\M-g]) - (define-key function-key-map "\e[093q" [?\M-j]) + (define-key map "\e[092q" [?\M-h]) - (define-key function-key-map "\e[094q" [?\M-k]) + (define-key map "\e[093q" [?\M-j]) - (define-key function-key-map "\e[095q" [?\M-l]) + (define-key map "\e[094q" [?\M-k]) - (define-key function-key-map "\e[096q" [?\C-\;]) - (define-key function-key-map "\e[097q" [?\M-:]) ;; we are cheating - ;; here, this is - ;; realy M-;, but - ;; M-: generates the - ;; same string and - ;; is more usefull. + (define-key map "\e[095q" [?\M-l]) - (define-key function-key-map "\e[098q" [?\C-']) - (define-key function-key-map "\e[099q" [?\M-']) + (define-key map "\e[096q" [?\C-\;]) + ;; We are cheating here, this is really M-;, but M-: generates the same + ;; string and is more useful. + (define-key map "\e[097q" [?\M-:]) - (define-key function-key-map "\e[100q" [?\M-\n]) + (define-key map "\e[098q" [?\C-']) + (define-key map "\e[099q" [?\M-']) - (define-key function-key-map "\e[101q" [?\M-z]) + (define-key map "\e[100q" [?\M-\n]) - (define-key function-key-map "\e[102q" [?\M-x]) + (define-key map "\e[101q" [?\M-z]) - (define-key function-key-map "\e[103q" [?\M-c]) + (define-key map "\e[102q" [?\M-x]) - (define-key function-key-map "\e[104q" [?\M-v]) + (define-key map "\e[103q" [?\M-c]) - (define-key function-key-map "\e[105q" [?\M-b]) + (define-key map "\e[104q" [?\M-v]) - (define-key function-key-map "\e[106q" [M-n]) + (define-key map "\e[105q" [?\M-b]) - (define-key function-key-map "\e[107q" [M-m]) + (define-key map "\e[106q" [M-n]) - (define-key function-key-map "\e[108q" [?\C-,]) - (define-key function-key-map "\e[109q" [?\M-,]) + (define-key map "\e[107q" [M-m]) - (define-key function-key-map "\e[110q" [?\C-.]) - (define-key function-key-map "\e[111q" [?\M-.]) + (define-key map "\e[108q" [?\C-,]) + (define-key map "\e[109q" [?\M-,]) - (define-key function-key-map "\e[112q" [?\C-/]) - (define-key function-key-map "\e[113q" [?\M-/]) + (define-key map "\e[110q" [?\C-.]) + (define-key map "\e[111q" [?\M-.]) - (define-key function-key-map "\e[139q" [insert]) - (define-key function-key-map "\e[139q" [S-insert]) - (define-key function-key-map "\e[140q" [C-insert]) - (define-key function-key-map "\e[141q" [M-insert]) + (define-key map "\e[112q" [?\C-/]) + (define-key map "\e[113q" [?\M-/]) - (define-key function-key-map "\e[H" [home]) - (define-key function-key-map "\e[143q" [S-home]) - (define-key function-key-map "\e[144q" [C-home]) + (define-key map "\e[139q" [insert]) + (define-key map "\e[139q" [S-insert]) + (define-key map "\e[140q" [C-insert]) + (define-key map "\e[141q" [M-insert]) + (define-key map "\e[H" [home]) + (define-key map "\e[143q" [S-home]) + (define-key map "\e[144q" [C-home]) - (define-key function-key-map "\e[150q" [prior]) - (define-key function-key-map "\e[151q" [S-prior]) ;; those don't - ;; seem to - ;; generate - ;; anything - (define-key function-key-map "\e[152q" [C-prior]) + (define-key map "\e[150q" [prior]) + (define-key map "\e[151q" [S-prior]) ;Those don't seem to generate anything. + (define-key map "\e[152q" [C-prior]) - ;; (define-key function-key-map "^?" [delete]) - (define-key function-key-map "\e[P" [S-delete]) - (define-key function-key-map "\e[142q" [C-delete]) - (define-key function-key-map "\e[M" [M-delete]) - (define-key function-key-map "\e[146q" [end]) - (define-key function-key-map "\e[147q" [S-end]) ;; those don't seem - ;; to generate - ;; anything - (define-key function-key-map "\e[148q" [C-end]) + ;; (define-key map "^?" [delete]) ?? something else seems to take care of this. + (define-key map "\e[P" [S-delete]) + (define-key map "\e[142q" [C-delete]) + (define-key map "\e[M" [M-delete]) - (define-key function-key-map "\e[154q" [next]) - (define-key function-key-map "\e[155q" [S-next]) - (define-key function-key-map "\e[156q" [C-next]) + (define-key map "\e[146q" [end]) + (define-key map "\e[147q" [S-end]) ; Those don't seem to generate anything. + (define-key map "\e[148q" [C-end]) + (define-key map "\e[154q" [next]) + (define-key map "\e[155q" [S-next]) + (define-key map "\e[156q" [C-next]) - (define-key function-key-map "\e[161q" [S-up]) - (define-key function-key-map "\e[162q" [C-up]) - (define-key function-key-map "\e[163q" [M-up]) - (define-key function-key-map "\e[158q" [S-left]) - (define-key function-key-map "\e[159q" [C-left]) - (define-key function-key-map "\e[160q" [M-left]) + (define-key map "\e[161q" [S-up]) + (define-key map "\e[162q" [C-up]) + (define-key map "\e[163q" [M-up]) - (define-key function-key-map "\e[164q" [S-down]) - (define-key function-key-map "\e[165q" [C-down]) - (define-key function-key-map "\e[166q" [M-down]) + (define-key map "\e[158q" [S-left]) + (define-key map "\e[159q" [C-left]) + (define-key map "\e[160q" [M-left]) - (define-key function-key-map "\e[167q" [S-right]) - (define-key function-key-map "\e[168q" [C-right]) - (define-key function-key-map "\e[169q" [M-right]) + (define-key map "\e[164q" [S-down]) + (define-key map "\e[165q" [C-down]) + (define-key map "\e[166q" [M-down]) - ;; Keypad functions, most of those are untested. - (define-key function-key-map "\e[179q" [?\C-/]) - (define-key function-key-map "\e[180q" [?\M-/]) + (define-key map "\e[167q" [S-right]) + (define-key map "\e[168q" [C-right]) + (define-key map "\e[169q" [M-right]) - (define-key function-key-map "\e[187q" [?\C-*]) - (define-key function-key-map "\e[188q" [?\M-*]) + ;; Keypad functions, most of those are untested. + (define-key map "\e[179q" [?\C-/]) + (define-key map "\e[180q" [?\M-/]) - (define-key function-key-map "\e[198q" [?\C--]) - (define-key function-key-map "\e[199q" [?\M--]) + (define-key map "\e[187q" [?\C-*]) + (define-key map "\e[188q" [?\M-*]) - ;; Something else takes care of home, up, prior, down, left, right, next - ;;(define-key function-key-map "\e[H" [home]) - (define-key function-key-map "\e[172q" [C-home]) + (define-key map "\e[198q" [?\C--]) + (define-key map "\e[199q" [?\M--]) - ;;(define-key function-key-map "\e[A" [up]) - (define-key function-key-map "\e[182q" [C-up]) + ;; Something else takes care of home, up, prior, down, left, right, next + ;;(define-key map "\e[H" [home]) + (define-key map "\e[172q" [C-home]) + ;;(define-key map "\e[A" [up]) + (define-key map "\e[182q" [C-up]) - ;;(define-key function-key-map "\e[150q" [prior]) - (define-key function-key-map "\e[190q" [C-prior]) + ;;(define-key map "\e[150q" [prior]) + (define-key map "\e[190q" [C-prior]) - (define-key function-key-map "\e[200q" [?\C-+]) - (define-key function-key-map "\e[201q" [?\M-+]) - ;;(define-key function-key-map "\e[D" [left]) - (define-key function-key-map "\e[174q" [C-left]) + (define-key map "\e[200q" [?\C-+]) + (define-key map "\e[201q" [?\M-+]) + ;;(define-key map "\e[D" [left]) + (define-key map "\e[174q" [C-left]) - (define-key function-key-map "\e[000q" [begin]) - (define-key function-key-map "\e[184q" [C-begin]) + (define-key map "\e[000q" [begin]) + (define-key map "\e[184q" [C-begin]) - ;;(define-key function-key-map "\e[C" [right]) - (define-key function-key-map "\e[192q" [C-right]) - ;;(define-key function-key-map "\e[146q" [end]) - (define-key function-key-map "\e[176q" [C-end]) + ;;(define-key map "\e[C" [right]) + (define-key map "\e[192q" [C-right]) - ;;(define-key function-key-map "\e[B" [down]) - (define-key function-key-map "\e[186q" [C-down]) + ;;(define-key map "\e[146q" [end]) + (define-key map "\e[176q" [C-end]) - ;;(define-key function-key-map "\e[154q" [next]) - (define-key function-key-map "\e[194q" [C-next]) + ;;(define-key map "\e[B" [down]) + (define-key map "\e[186q" [C-down]) + ;;(define-key map "\e[154q" [next]) + (define-key map "\e[194q" [C-next]) - (define-key function-key-map "\e[100q" [M-enter]) + (define-key map "\e[100q" [M-enter]) - (define-key function-key-map "\e[139q" [insert]) - (define-key function-key-map "\e[178q" [C-inset]) + (define-key map "\e[139q" [insert]) + (define-key map "\e[178q" [C-inset]) - (define-key function-key-map "\e[P" [delete]) - (define-key function-key-map "\e[196q" [C-delete]) - (define-key function-key-map "\e[197q" [M-delete])) + (define-key map "\e[P" [delete]) + (define-key map "\e[196q" [C-delete]) + (define-key map "\e[197q" [M-delete]) + map) + "Function key definitions for SGI xwsh and winterm apps.") -;;; arch-tag: b1d0e73a-bb7d-47be-9fb2-6fb126469a1b +(defun terminal-init-iris-ansi () + "Terminal initialization function for iris-ansi." + ;; Use inheritance to let the main keymap override these defaults. + ;; This way we don't override terminfo-derived settings or settings + ;; made in the .emacs file. + (let ((m (copy-keymap iris-function-map))) + (set-keymap-parent m (keymap-parent input-decode-map)) + (set-keymap-parent input-decode-map m))) + +;; arch-tag: b1d0e73a-bb7d-47be-9fb2-6fb126469a1b ;;; iris-ansi.el ends here diff --git a/lisp/term/linux.el b/lisp/term/linux.el index 7fa9a96e9bd..fdd8e2229ac 100644 --- a/lisp/term/linux.el +++ b/lisp/term/linux.el @@ -9,13 +9,15 @@ ;; It can't really display underlines. (tty-no-underline) + (condition-case nil (t-mouse-mode 1) + (error nil)) + ;; Make Latin-1 input characters work, too. ;; Meta will continue to work, because the kernel ;; turns that into Escape. - (let ((value (current-input-mode))) - ;; The third arg only matters in that it is not t or nil. - (set-input-mode (nth 0 value) (nth 1 value) 'iso-latin-1 (nth 3 value)))) + ;; The arg only matters in that it is not t or nil. + (set-input-meta-mode 'iso-latin-1)) ;;; arch-tag: 5d0c4f63-739b-4862-abf3-041fe42adb8f ;;; linux.el ends here diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el index 1f8d9ca77a3..7bcbd8d754c 100644 --- a/lisp/term/lk201.el +++ b/lisp/term/lk201.el @@ -1,72 +1,83 @@ ;; -*- no-byte-compile: t -*- ;; Define function key sequences for DEC terminals. +(defvar lk201-function-map (make-sparse-keymap) + "Function key definitions for DEC terminals.") + ;; Termcap or terminfo should set these. -;; (define-key function-key-map "\e[A" [up]) -;; (define-key function-key-map "\e[B" [down]) -;; (define-key function-key-map "\e[C" [right]) -;; (define-key function-key-map "\e[D" [left]) +;; (define-key lk201-function-map "\e[A" [up]) +;; (define-key lk201-function-map "\e[B" [down]) +;; (define-key lk201-function-map "\e[C" [right]) +;; (define-key lk201-function-map "\e[D" [left]) -(define-key function-key-map "\e[1~" [find]) -(define-key function-key-map "\e[2~" [insert]) -(define-key function-key-map "\e[3~" [delete]) -(define-key function-key-map "\e[4~" [select]) -(define-key function-key-map "\e[5~" [prior]) -(define-key function-key-map "\e[6~" [next]) -(define-key function-key-map "\e[11~" [f1]) -(define-key function-key-map "\e[12~" [f2]) -(define-key function-key-map "\e[13~" [f3]) -(define-key function-key-map "\e[14~" [f4]) -(define-key function-key-map "\e[15~" [f5]) -(define-key function-key-map "\e[17~" [f6]) -(define-key function-key-map "\e[18~" [f7]) -(define-key function-key-map "\e[19~" [f8]) -(define-key function-key-map "\e[20~" [f9]) -(define-key function-key-map "\e[21~" [f10]) +(define-key lk201-function-map "\e[1~" [find]) +(define-key lk201-function-map "\e[2~" [insert]) +(define-key lk201-function-map "\e[3~" [delete]) +(define-key lk201-function-map "\e[4~" [select]) +(define-key lk201-function-map "\e[5~" [prior]) +(define-key lk201-function-map "\e[6~" [next]) +(define-key lk201-function-map "\e[11~" [f1]) +(define-key lk201-function-map "\e[12~" [f2]) +(define-key lk201-function-map "\e[13~" [f3]) +(define-key lk201-function-map "\e[14~" [f4]) +(define-key lk201-function-map "\e[15~" [f5]) +(define-key lk201-function-map "\e[17~" [f6]) +(define-key lk201-function-map "\e[18~" [f7]) +(define-key lk201-function-map "\e[19~" [f8]) +(define-key lk201-function-map "\e[20~" [f9]) +(define-key lk201-function-map "\e[21~" [f10]) ;; Customarily F11 is used as the ESC key. ;; The file that includes this one, takes care of that. -(define-key function-key-map "\e[23~" [f11]) -(define-key function-key-map "\e[24~" [f12]) -(define-key function-key-map "\e[25~" [f13]) -(define-key function-key-map "\e[26~" [f14]) -(define-key function-key-map "\e[28~" [help]) -(define-key function-key-map "\e[29~" [menu]) -(define-key function-key-map "\e[31~" [f17]) -(define-key function-key-map "\e[32~" [f18]) -(define-key function-key-map "\e[33~" [f19]) -(define-key function-key-map "\e[34~" [f20]) +(define-key lk201-function-map "\e[23~" [f11]) +(define-key lk201-function-map "\e[24~" [f12]) +(define-key lk201-function-map "\e[25~" [f13]) +(define-key lk201-function-map "\e[26~" [f14]) +(define-key lk201-function-map "\e[28~" [help]) +(define-key lk201-function-map "\e[29~" [menu]) +(define-key lk201-function-map "\e[31~" [f17]) +(define-key lk201-function-map "\e[32~" [f18]) +(define-key lk201-function-map "\e[33~" [f19]) +(define-key lk201-function-map "\e[34~" [f20]) ;; Termcap or terminfo should set these. -;; (define-key function-key-map "\eOA" [up]) -;; (define-key function-key-map "\eOB" [down]) -;; (define-key function-key-map "\eOC" [right]) -;; (define-key function-key-map "\eOD" [left]) +;; (define-key lk201-function-map "\eOA" [up]) +;; (define-key lk201-function-map "\eOB" [down]) +;; (define-key lk201-function-map "\eOC" [right]) +;; (define-key lk201-function-map "\eOD" [left]) ;; Termcap or terminfo should set these, but doesn't properly. ;; Termcap sets these to k1-k4, which get mapped to f1-f4 in term.c -(define-key function-key-map "\eOP" [kp-f1]) -(define-key function-key-map "\eOQ" [kp-f2]) -(define-key function-key-map "\eOR" [kp-f3]) -(define-key function-key-map "\eOS" [kp-f4]) +(define-key lk201-function-map "\eOP" [kp-f1]) +(define-key lk201-function-map "\eOQ" [kp-f2]) +(define-key lk201-function-map "\eOR" [kp-f3]) +(define-key lk201-function-map "\eOS" [kp-f4]) + +(define-key lk201-function-map "\eOI" [kp-tab]) +(define-key lk201-function-map "\eOj" [kp-multiply]) +(define-key lk201-function-map "\eOk" [kp-add]) +(define-key lk201-function-map "\eOl" [kp-separator]) +(define-key lk201-function-map "\eOM" [kp-enter]) +(define-key lk201-function-map "\eOm" [kp-subtract]) +(define-key lk201-function-map "\eOn" [kp-decimal]) +(define-key lk201-function-map "\eOo" [kp-divide]) +(define-key lk201-function-map "\eOp" [kp-0]) +(define-key lk201-function-map "\eOq" [kp-1]) +(define-key lk201-function-map "\eOr" [kp-2]) +(define-key lk201-function-map "\eOs" [kp-3]) +(define-key lk201-function-map "\eOt" [kp-4]) +(define-key lk201-function-map "\eOu" [kp-5]) +(define-key lk201-function-map "\eOv" [kp-6]) +(define-key lk201-function-map "\eOw" [kp-7]) +(define-key lk201-function-map "\eOx" [kp-8]) +(define-key lk201-function-map "\eOy" [kp-9]) -(define-key function-key-map "\eOI" [kp-tab]) -(define-key function-key-map "\eOj" [kp-multiply]) -(define-key function-key-map "\eOk" [kp-add]) -(define-key function-key-map "\eOl" [kp-separator]) -(define-key function-key-map "\eOM" [kp-enter]) -(define-key function-key-map "\eOm" [kp-subtract]) -(define-key function-key-map "\eOn" [kp-decimal]) -(define-key function-key-map "\eOo" [kp-divide]) -(define-key function-key-map "\eOp" [kp-0]) -(define-key function-key-map "\eOq" [kp-1]) -(define-key function-key-map "\eOr" [kp-2]) -(define-key function-key-map "\eOs" [kp-3]) -(define-key function-key-map "\eOt" [kp-4]) -(define-key function-key-map "\eOu" [kp-5]) -(define-key function-key-map "\eOv" [kp-6]) -(define-key function-key-map "\eOw" [kp-7]) -(define-key function-key-map "\eOx" [kp-8]) -(define-key function-key-map "\eOy" [kp-9]) +(defun terminal-init-lk201 () + ;; Use inheritance to let the main keymap override these defaults. + ;; This way we don't override terminfo-derived settings or settings + ;; made in the .emacs file. + (let ((m (copy-keymap lk201-function-map))) + (set-keymap-parent m (keymap-parent input-decode-map)) + (set-keymap-parent input-decode-map m))) -;;; arch-tag: 7ffb4444-6a23-43e1-b457-43cf4f673c0d +;; arch-tag: 7ffb4444-6a23-43e1-b457-43cf4f673c0d ;;; lk201.el ends here diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 7bf738bdd50..f3d3e737042 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -65,8 +65,8 @@ ;; An alist of X options and the function which handles them. See ;; ../startup.el. -(if (not (eq window-system 'mac)) - (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name))) +;; (if (not (eq window-system 'mac)) +;; (error "%s: Loading mac-win.el but not compiled for Mac" (invocation-name))) (require 'frame) (require 'mouse) @@ -84,6 +84,14 @@ (defvar mac-font-panel-mode) (defvar mac-ts-active-input-overlay) (defvar x-invocation-args) +(declare-function mac-code-convert-string "mac.c") +(declare-function mac-coerce-ae-data "mac.c") +(declare-function mac-resume-apple-event "macselect.c") +;; Suppress warning when compiling on non-Mac. +(declare-function mac-font-panel-mode "mac-win.el") +(declare-function mac-atsu-font-face-attributes "macfns.c") +(declare-function mac-ae-set-reply-parameter "macselect.c") +(declare-function mac-clear-font-name-table "macfns.c") (defvar x-command-line-resources nil) @@ -1058,25 +1066,31 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;;; Function keys -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - -;; Map certain keypad keys into ASCII characters -;; that people usually expect. -(define-key function-key-map [backspace] [?\d]) -(define-key function-key-map [delete] [?\d]) -(define-key function-key-map [tab] [?\t]) -(define-key function-key-map [linefeed] [?\n]) -(define-key function-key-map [clear] [?\C-l]) -(define-key function-key-map [return] [?\C-m]) -(define-key function-key-map [escape] [?\e]) -(define-key function-key-map [M-backspace] [?\M-\d]) -(define-key function-key-map [M-delete] [?\M-\d]) -(define-key function-key-map [M-tab] [?\M-\t]) -(define-key function-key-map [M-linefeed] [?\M-\n]) -(define-key function-key-map [M-clear] [?\M-\C-l]) -(define-key function-key-map [M-return] [?\M-\C-m]) -(define-key function-key-map [M-escape] [?\M-\e]) +(defun x-setup-function-keys (frame) + "Setup Function Keys for mac." + ;; Don't do this twice on the same display, or it would break + ;; normal-erase-is-backspace-mode. + (unless (terminal-parameter frame 'x-setup-function-keys) + (with-selected-frame frame + ;; Map certain keypad keys into ASCII characters + ;; that people usually expect. + (define-key local-function-key-map [backspace] [?\d]) + (define-key local-function-key-map [delete] [?\d]) + (define-key local-function-key-map [tab] [?\t]) + (define-key local-function-key-map [linefeed] [?\n]) + (define-key local-function-key-map [clear] [?\C-l]) + (define-key local-function-key-map [return] [?\C-m]) + (define-key local-function-key-map [escape] [?\e]) + (define-key local-function-key-map [M-backspace] [?\M-\d]) + (define-key local-function-key-map [M-delete] [?\M-\d]) + (define-key local-function-key-map [M-tab] [?\M-\t]) + (define-key local-function-key-map [M-linefeed] [?\M-\n]) + (define-key local-function-key-map [M-clear] [?\M-\C-l]) + (define-key local-function-key-map [M-return] [?\M-\C-m]) + (define-key local-function-key-map [M-escape] [?\M-\e]) + (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame + local-function-key-map global-map)) + (set-terminal-parameter frame 'x-setup-function-keys t))) ;; These tell read-char how to convert ;; these special chars to ASCII. @@ -1709,6 +1723,19 @@ in `selection-converter-alist', which see." (setq modifiers (cons (car modifier-mask) modifiers))))) modifiers)) +(defun mac-ae-reopen-application (event) + "Show some frame in response to the Apple event EVENT. +The frame to be shown is chosen from visible or iconified frames +if possible. If there's no such frame, a new frame is created." + (interactive "e") + (unless (frame-visible-p (selected-frame)) + (let ((frame (or (car (visible-frame-list)) + (car (filtered-frame-list 'frame-visible-p))))) + (if frame + (select-frame frame) + (switch-to-buffer-other-frame "*scratch*")))) + (select-frame-set-input-focus (selected-frame))) + (defun mac-ae-open-documents (event) "Open the documents specified by the Apple event EVENT." (interactive "e") @@ -1745,6 +1772,9 @@ in `selection-converter-alist', which see." ;; Reaches here if the user has canceled the quit. (mac-resume-apple-event ae -128)))) ; userCanceledErr +;; url-generic-parse-url is autoloaded from url-parse. +(declare-function url-type "url-parse" t t) ; defstruct + (defun mac-ae-get-url (event) "Open the URL specified by the Apple event EVENT. Currently the `mailto' scheme is supported." @@ -1765,9 +1795,9 @@ Currently the `mailto' scheme is supported." (define-key mac-apple-event-map [core-event open-application] 0) ;; Received when a dock or application icon is clicked and Emacs is -;; already running. Simply ignored. Another idea is to make a new -;; frame if all frames are invisible. -(define-key mac-apple-event-map [core-event reopen-application] 'ignore) +;; already running. +(define-key mac-apple-event-map [core-event reopen-application] + 'mac-ae-reopen-application) (define-key mac-apple-event-map [core-event open-documents] 'mac-ae-open-documents) @@ -2148,7 +2178,7 @@ either in the current buffer or in the echo area." (if (not buffer-read-only) (insert text) (kill-new text) - (message + (message "%s" (substitute-command-keys "The text from the Services menu can be accessed with \\[yank]"))))) @@ -2251,7 +2281,7 @@ See also `mac-dnd-known-types'." (handler (cdr type-info)) (w (posn-window (event-start event)))) (when handler - (if (and (windowp w) (window-live-p w) + (if (and (window-live-p w) (not (window-minibuffer-p w)) (not (window-dedicated-p w))) ;; If dropping in an ordinary window which we could use, @@ -2280,34 +2310,6 @@ See also `mac-dnd-known-types'." (mac-dnd-drop-data event (selected-frame) window (cdr item) (car item) action))))) -;;; Do the actual Windows setup here; the above code just defines -;;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) - -;;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (let (i) - (setq x-resource-name (invocation-name)) - - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (while (setq i (string-match "[.*]" x-resource-name)) - (aset x-resource-name i ?-)))) - -(if (x-display-list) - ;; On Mac OS 8/9, Most coding systems used in code conversion for - ;; font names are not ready at the time when the terminal frame is - ;; created. So we reconstruct font name table for the initial - ;; frame. - (mac-clear-font-name-table) - (x-open-connection "Mac" - x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t)) - -(setq frame-creation-function 'x-create-frame-with-faces) - (defvar mac-font-encoder-list '(("mac-roman" mac-roman-encoder ccl-encode-mac-roman-font "%s") @@ -2485,6 +2487,88 @@ It returns a name of the created fontset." (fontset-add-mac-fonts fontset t) fontset)) +(defun x-win-suspend-error () + (error "Suspending an Emacs running under Mac makes no sense")) + +(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) + +(defvar mac-initialized nil + "Non-nil if the w32 window system has been initialized.") + +(defun mac-initialize-window-system () + "Initialize Emacs for Mac GUI frames." + +;;; Do the actual Windows setup here; the above code just defines +;;; functions and variables that we use now. + +(setq command-line-args (x-handle-args command-line-args)) + +;;; Make sure we have a valid resource name. +(or (stringp x-resource-name) + (let (i) + (setq x-resource-name (invocation-name)) + + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (while (setq i (string-match "[.*]" x-resource-name)) + (aset x-resource-name i ?-)))) + +(if (x-display-list) + ;; On Mac OS 8/9, Most coding systems used in code conversion for + ;; font names are not ready at the time when the terminal frame is + ;; created. So we reconstruct font name table for the initial + ;; frame. + (mac-clear-font-name-table) + (x-open-connection "Mac" + x-command-line-resources + ;; Exit Emacs with fatal error if this fails. + t)) + +(add-hook 'suspend-hook 'x-win-suspend-error) + +;;; Arrange for the kill and yank functions to set and check the clipboard. +(setq interprogram-cut-function 'x-select-text) +(setq interprogram-paste-function 'x-get-selection-value) + + + + +;;; Turn off window-splitting optimization; Mac is usually fast enough +;;; that this is only annoying. +(setq split-window-keep-point t) + +;; Don't show the frame name; that's redundant. +(setq-default mode-line-frame-identification " ") + +;; Turn on support for mouse wheels. +(mouse-wheel-mode 1) + + +;; Enable CLIPBOARD copy/paste through menu bar commands. +(menu-bar-enable-clipboard) + + +;; Initiate drag and drop + +(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) + + +;;;; Non-toolkit Scroll bars + +(unless x-toolkit-scroll-bars + +;; for debugging +;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) + +;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) + +(global-set-key + [vertical-scroll-bar down-mouse-1] + 'mac-handle-scroll-bar-event) + +(global-unset-key [vertical-scroll-bar drag-mouse-1]) +(global-unset-key [vertical-scroll-bar mouse-1]) + ;; Adjust Courier font specifications in x-fixed-font-alist. (let ((courier-fonts (assoc "Courier" x-fixed-font-alist))) (if courier-fonts @@ -2591,50 +2675,7 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") (setq default-frame-alist (cons '(reverse . t) default-frame-alist))))) -(defun x-win-suspend-error () - (error "Suspending an Emacs running under Mac makes no sense")) -(add-hook 'suspend-hook 'x-win-suspend-error) - -;;; Arrange for the kill and yank functions to set and check the clipboard. -(setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-get-selection-value) - -(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) - -;;; Turn off window-splitting optimization; Mac is usually fast enough -;;; that this is only annoying. -(setq split-window-keep-point t) - -;; Don't show the frame name; that's redundant. -(setq-default mode-line-frame-identification " ") - -;; Turn on support for mouse wheels. -(mouse-wheel-mode 1) - - -;; Enable CLIPBOARD copy/paste through menu bar commands. -(menu-bar-enable-clipboard) - -;; Initiate drag and drop - -(define-key special-event-map [drag-n-drop] 'mac-dnd-handle-drag-n-drop-event) - - -;;;; Non-toolkit Scroll bars - -(unless x-toolkit-scroll-bars - -;; for debugging -;; (defun mac-handle-scroll-bar-event (event) (interactive "e") (princ event)) - -;;(global-set-key [vertical-scroll-bar mouse-1] 'mac-handle-scroll-bar-event) - -(global-set-key - [vertical-scroll-bar down-mouse-1] - 'mac-handle-scroll-bar-event) - -(global-unset-key [vertical-scroll-bar drag-mouse-1]) -(global-unset-key [vertical-scroll-bar mouse-1]) +(setq mac-initialized t))) (defun mac-handle-scroll-bar-event (event) "Handle scroll bar EVENT to emulate Mac Toolbox style scrolling." @@ -2682,7 +2723,6 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") (mac-scroll-ignore-events) (scroll-up 1))) -) ;;;; Others @@ -2720,5 +2760,11 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") ;; or bold bitmap versions will not display these variants correctly. (setq scalable-fonts-allowed t) +(add-to-list 'handle-args-function-alist '(mac . x-handle-args)) +(add-to-list 'frame-creation-function-alist '(mac . x-create-frame-with-faces)) +(add-to-list 'window-system-initialization-alist '(mac . mac-initialize-window-system)) + +(provide 'mac-win) + ;; arch-tag: 71dfcd14-cde8-4d66-b05c-85ec94fb23a6 ;;; mac-win.el ends here diff --git a/lisp/term/news.el b/lisp/term/news.el index 5b7e904b477..5f7195ca984 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -31,10 +31,8 @@ (defun terminal-init-news () "Terminal initialization function for news." - (if (boundp 'news-fkey-prefix) - nil - ;; The terminal initialization should already have set up some keys - (setq news-fkey-prefix (lookup-key function-key-map "\eO")) + ;; The terminal initialization should already have set up some keys + (let ((news-fkey-prefix (lookup-key input-decode-map "\eO"))) (if (not (keymapp news-fkey-prefix)) (error "What? Your news termcap/terminfo has no keycaps in it")) @@ -73,5 +71,5 @@ (define-key news-fkey-prefix "x" [kp-8]) )) -;;; arch-tag: bfe141a0-623b-4b42-b753-5d9353776c5e +;; arch-tag: bfe141a0-623b-4b42-b753-5d9353776c5e ;;; news.el ends here diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index 1860b9370d5..e3bb01eded9 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -29,6 +29,10 @@ (load "term/internal" nil t) +(declare-function msdos-remember-default-colors "msdos.c") +(declare-function w16-set-clipboard-data "w16select.c") +(declare-function w16-get-clipboard-data "w16select.c") + ;;; This is copied from etc/rgb.txt, except that some values were changed ;;; a bit to make them consistent with DOS console colors, and the RGB ;;; values were scaled up to 16 bits, as `tty-define-color' requires. @@ -130,7 +134,7 @@ (unless success (delete-frame frame))) frame)) -(setq frame-creation-function 'make-msdos-frame) +(add-to-list 'frame-creation-function-alist '(pc . make-msdos-frame)) ;; --------------------------------------------------------------------------- ;; More or less useful imitations of certain X-functions. A lot of the diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index 11f9ba6f3d3..60f5acd2546 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -26,51 +26,10 @@ ;;; Code: -(defun terminal-init-rxvt () - "Terminal initialization function for rxvt." - ;; The terminal intialization C code file might have initialized - ;; function keys F11->F42 from the termcap/terminfo information. On - ;; a PC-style keyboard these keys correspond to - ;; MODIFIER-FUNCTION_KEY, where modifier is S-, C-, C-S-. The - ;; code here subsitutes the corresponding defintions in - ;; function-key-map. This substitution is needed because if a key - ;; definition if found in function-key-map, there are no further - ;; lookups in other keymaps. - (substitute-key-definition [f11] [S-f1] function-key-map) - (substitute-key-definition [f12] [S-f2] function-key-map) - (substitute-key-definition [f13] [S-f3] function-key-map) - (substitute-key-definition [f14] [S-f4] function-key-map) - (substitute-key-definition [f15] [S-f5] function-key-map) - (substitute-key-definition [f16] [S-f6] function-key-map) - (substitute-key-definition [f17] [S-f7] function-key-map) - (substitute-key-definition [f18] [S-f8] function-key-map) - (substitute-key-definition [f19] [S-f9] function-key-map) - (substitute-key-definition [f20] [S-f10] function-key-map) - - (substitute-key-definition [f23] [C-f1] function-key-map) - (substitute-key-definition [f24] [C-f2] function-key-map) - (substitute-key-definition [f25] [C-f3] function-key-map) - (substitute-key-definition [f26] [C-f4] function-key-map) - (substitute-key-definition [f27] [C-f5] function-key-map) - (substitute-key-definition [f28] [C-f6] function-key-map) - (substitute-key-definition [f29] [C-f7] function-key-map) - (substitute-key-definition [f30] [C-f8] function-key-map) - (substitute-key-definition [f31] [C-f9] function-key-map) - (substitute-key-definition [f32] [C-f10] function-key-map) - - (substitute-key-definition [f33] [C-S-f1] function-key-map) - (substitute-key-definition [f34] [C-S-f2] function-key-map) - (substitute-key-definition [f35] [C-S-f3] function-key-map) - (substitute-key-definition [f36] [C-S-f4] function-key-map) - (substitute-key-definition [f37] [C-S-f5] function-key-map) - (substitute-key-definition [f38] [C-S-f6] function-key-map) - (substitute-key-definition [f39] [C-S-f7] function-key-map) - (substitute-key-definition [f40] [C-S-f8] function-key-map) - (substitute-key-definition [f41] [C-S-f9] function-key-map) - (substitute-key-definition [f42] [C-S-f10] function-key-map) - - ;; Set up function-key-map entries that termcap and terminfo don't know. +(defvar rxvt-function-map (let ((map (make-sparse-keymap))) + + ;; 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]) @@ -94,8 +53,8 @@ (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 map "\e[23~" [f11]) - ;; (define-key map "\e[24~" [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[11^" [C-f1]) @@ -152,12 +111,67 @@ (define-key map "\e[c" [S-right]) (define-key map "\e[a" [S-up]) (define-key map "\e[b" [S-down]) + map) + "Function key overrides for rxvt.") + +(defvar rxvt-alternatives-map + (let ((map (make-sparse-keymap))) + ;; The terminal intialization C code file might have initialized + ;; function keys F11->F42 from the termcap/terminfo information. On + ;; a PC-style keyboard these keys correspond to + ;; MODIFIER-FUNCTION_KEY, where modifier is S-, C-, C-S-. The + ;; code here subsitutes the corresponding defintions in + ;; function-key-map. This substitution is needed because if a key + ;; definition if found in function-key-map, there are no further + ;; lookups in other keymaps. + (define-key map [f11] [S-f1]) + (define-key map [f12] [S-f2]) + (define-key map [f13] [S-f3]) + (define-key map [f14] [S-f4]) + (define-key map [f15] [S-f5]) + (define-key map [f16] [S-f6]) + (define-key map [f17] [S-f7]) + (define-key map [f18] [S-f8]) + (define-key map [f19] [S-f9]) + (define-key map [f20] [S-f10]) - ;; Use inheritance to let the main keymap override those defaults. - ;; This way we don't override terminfo-derived settings or settings - ;; made in the .emacs file. - (set-keymap-parent map (keymap-parent function-key-map)) - (set-keymap-parent function-key-map map)) + (define-key map [f23] [C-f1]) + (define-key map [f24] [C-f2]) + (define-key map [f25] [C-f3]) + (define-key map [f26] [C-f4]) + (define-key map [f27] [C-f5]) + (define-key map [f28] [C-f6]) + (define-key map [f29] [C-f7]) + (define-key map [f30] [C-f8]) + (define-key map [f31] [C-f9]) + (define-key map [f32] [C-f10]) + + (define-key map [f33] [C-S-f1]) + (define-key map [f34] [C-S-f2]) + (define-key map [f35] [C-S-f3]) + (define-key map [f36] [C-S-f4]) + (define-key map [f37] [C-S-f5]) + (define-key map [f38] [C-S-f6]) + (define-key map [f39] [C-S-f7]) + (define-key map [f40] [C-S-f8]) + (define-key map [f41] [C-S-f9]) + (define-key map [f42] [C-S-f10]) + 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 .emacs 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) @@ -239,7 +253,7 @@ for the currently selected frame." (- 256 ncolors) (list color color color)) (setq ncolors (1- ncolors)))) - + ((= ncolors 72) ; rxvt-unicode ;; 64 non-gray colors (let ((levels '(0 139 205 255)) @@ -282,7 +296,7 @@ for the currently selected frame." "Set background mode as appropriate for the default rxvt colors." (let ((fgbg (getenv "COLORFGBG")) bg rgb) - (setq default-frame-background-mode 'light) + (set-terminal-parameter nil 'background-mode 'light) (when (and fgbg (string-match ".*;\\([0-9][0-9]?\\)\\'" fgbg)) (setq bg (string-to-number (substring fgbg (match-beginning 1)))) @@ -295,8 +309,7 @@ for the currently selected frame." ;; The following line assumes that white is the 15th ;; color in rxvt-standard-colors. (* (apply '+ (car (cddr (nth 15 rxvt-standard-colors)))) 0.6)) - (setq default-frame-background-mode 'dark))) - (frame-set-background-mode (selected-frame)))) + (set-terminal-parameter nil 'background-mode 'dark))))) ;; arch-tag: 20cf2fb6-6318-4bab-9dbf-1d15048f2257 ;;; rxvt.el ends here diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el deleted file mode 100644 index 2840e363009..00000000000 --- a/lisp/term/sun-mouse.el +++ /dev/null @@ -1,682 +0,0 @@ -;;; sun-mouse.el --- mouse handling for Sun windows - -;; Copyright (C) 1987, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008 Free Software Foundation, Inc. - -;; Author: Jeff Peck -;; Maintainer: FSF -;; Keywords: hardware - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; 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 -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; Jeff Peck, Sun Microsystems, Jan 1987. -;; Original idea by Stan Jefferson - -;; Modeled after the GNUEMACS keymap interface. -;; -;; User Functions: -;; make-mousemap, copy-mousemap, -;; define-mouse, global-set-mouse, local-set-mouse, -;; use-global-mousemap, use-local-mousemap, -;; mouse-lookup, describe-mouse-bindings -;; -;; Options: -;; extra-click-wait, scrollbar-width - -;;; Code: - -(defvar extra-click-wait 150 - "*Number of milliseconds to wait for an extra click. -Set this to zero if you don't want chords or double clicks.") - -(defvar scrollbar-width 5 - "*The character width of the scrollbar. -The cursor is deemed to be in the right edge scrollbar if it is this near the -right edge, and more than two chars past the end of the indicated line. -Setting to nil limits the scrollbar to the edge or vertical dividing bar.") - -;;; -;;; Mousemaps -;;; -(defun make-mousemap () - "Returns a new mousemap." - (cons 'mousemap nil)) - -;;; initialize mouse maps -(defvar current-global-mousemap (make-mousemap)) -(defvar current-local-mousemap nil) -(make-variable-buffer-local 'current-local-mousemap) - -(defun copy-mousemap (mousemap) - "Return a copy of mousemap." - (copy-alist mousemap)) - -(defun define-mouse (mousemap mouse-list def) - "Args MOUSEMAP, MOUSE-LIST, DEF. Define MOUSE-LIST in MOUSEMAP as DEF. -MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules: - * One of these atoms specifies the active region of the definition. - text, scrollbar, modeline, minibuffer - * One or two or these atoms specify the button or button combination. - left, middle, right, double - * Any combination of these atoms specify the active shift keys. - control, shift, meta - * With a single unshifted button, you can add - up - to indicate an up-click. -The atom `double' is used with a button designator to denote a double click. -Two button chords are denoted by listing the two buttons. -See sun-mouse-handler for the treatment of the form DEF." - (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def)) - -(defun global-set-mouse (mouse-list def) - "Give MOUSE-EVENT-LIST a local definition of DEF. -See define-mouse for a description of MOUSE-EVENT-LIST and DEF. -Note that if MOUSE-EVENT-LIST has a local definition in the current buffer, -that local definition will continue to shadow any global definition." - (interactive "xMouse event: \nxDefinition: ") - (define-mouse current-global-mousemap mouse-list def)) - -(defun local-set-mouse (mouse-list def) - "Give MOUSE-EVENT-LIST a local definition of DEF. -See define-mouse for a description of the arguments. -The definition goes in the current buffer's local mousemap. -Normally buffers in the same major mode share a local mousemap." - (interactive "xMouse event: \nxDefinition: ") - (if (null current-local-mousemap) - (setq current-local-mousemap (make-mousemap))) - (define-mouse current-local-mousemap mouse-list def)) - -(defun use-global-mousemap (mousemap) - "Selects MOUSEMAP as the global mousemap." - (setq current-global-mousemap mousemap)) - -(defun use-local-mousemap (mousemap) - "Selects MOUSEMAP as the local mousemap. -nil for MOUSEMAP means no local mousemap." - (setq current-local-mousemap mousemap)) - - -;;; -;;; Interface to the Mouse encoding defined in Emacstool.c -;;; -;;; Called when mouse-prefix is sent to emacs, additional -;;; information is read in as a list (button x y time-delta) -;;; -;;; First, some generally useful functions: -;;; - -(defun logtest (x y) - "True if any bits set in X are also set in Y. -Just like the Common Lisp function of the same name." - (not (zerop (logand x y)))) - - -;;; -;;; Hit accessors. -;;; - -(defconst sm::ButtonBits 7) ; Lowest 3 bits. -(defconst sm::ShiftmaskBits 56) ; Second lowest 3 bits (56 = 63 - 7). -(defconst sm::DoubleBits 64) ; Bit 7. -(defconst sm::UpBits 128) ; Bit 8. - -;;; All the useful code bits -(defmacro sm::hit-code (hit) - `(nth 0 ,hit)) -;;; The button, or buttons if a chord. -(defmacro sm::hit-button (hit) - `(logand sm::ButtonBits (nth 0 ,hit))) -;;; The shift, control, and meta flags. -(defmacro sm::hit-shiftmask (hit) - `(logand sm::ShiftmaskBits (nth 0 ,hit))) -;;; Set if a double click (but not a chord). -(defmacro sm::hit-double (hit) - `(logand sm::DoubleBits (nth 0 ,hit))) -;;; Set on button release (as opposed to button press). -(defmacro sm::hit-up (hit) - `(logand sm::UpBits (nth 0 ,hit))) -;;; Screen x position. -(defmacro sm::hit-x (hit) (list 'nth 1 hit)) -;;; Screen y position. -(defmacro sm::hit-y (hit) (list 'nth 2 hit)) -;;; Milliseconds since last hit. -(defmacro sm::hit-delta (hit) (list 'nth 3 hit)) - -(defmacro sm::hit-up-p (hit) ; A predicate. - `(not (zerop (sm::hit-up ,hit)))) - -;;; -;;; Loc accessors. for sm::window-xy -;;; -(defmacro sm::loc-w (loc) (list 'nth 0 loc)) -(defmacro sm::loc-x (loc) (list 'nth 1 loc)) -(defmacro sm::loc-y (loc) (list 'nth 2 loc)) - -(defmacro eval-in-buffer (buffer &rest forms) - "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer." - ;; When you don't need the complete window context of eval-in-window - `(let ((StartBuffer (current-buffer))) - (unwind-protect - (progn - (set-buffer ,buffer) - ,@forms) - (set-buffer StartBuffer)))) - -(put 'eval-in-buffer 'lisp-indent-function 1) - -;;; this is used extensively by sun-fns.el -;;; -(defmacro eval-in-window (window &rest forms) - "Switch to WINDOW, evaluate FORMS, return to original window." - `(let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (progn - (select-window ,window) - ,@forms) - (select-window OriginallySelectedWindow)))) -(put 'eval-in-window 'lisp-indent-function 1) - -;;; -;;; handy utility, generalizes window_loop -;;; - -;;; It's a macro (and does not evaluate its arguments). -(defmacro eval-in-windows (form &optional yesmini) - "Switches to each window and evaluates FORM. Optional argument -YESMINI says to include the minibuffer as a window. -This is a macro, and does not evaluate its arguments." - `(let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (while (progn - ,form - (not (eq OriginallySelectedWindow - (select-window - (next-window nil ,yesmini)))))) - (select-window OriginallySelectedWindow)))) -(put 'eval-in-window 'lisp-indent-function 0) - -(defun move-to-loc (x y) - "Move cursor to window location X, Y. -Handles wrapped and horizontally scrolled lines correctly." - (move-to-window-line y) - ;; window-line-end expects this to return the window column it moved to. - (let ((cc (current-column)) - (nc (move-to-column - (if (zerop (window-hscroll)) - (+ (current-column) - (min (- (window-width) 2) ; To stay on the line. - x)) - (+ (window-hscroll) -1 - (min (1- (window-width)) ; To stay on the line. - x)))))) - (- nc cc))) - - -(defun minibuffer-window-p (window) - "True if this WINDOW is minibuffer." - (= (frame-height) - (nth 3 (window-edges window)) ; The bottom edge. - )) - - -(defun sun-mouse-handler (&optional hit) - "Evaluates the function or list associated with a mouse hit. -Expecting to read a hit, which is a list: (button x y delta). -A form bound to button by define-mouse is found by mouse-lookup. -The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. -If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, -*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), -the form is eval'ed; if the form is neither of these, it is an error. -Returns nil." - (interactive) - (if (null hit) (setq hit (sm::combined-hits))) - (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit)))) - (let ((*mouse-window* (sm::loc-w loc)) - (*mouse-x* (sm::loc-x loc)) - (*mouse-y* (sm::loc-y loc)) - (mouse-code (mouse-event-code hit loc))) - (let ((form (eval-in-buffer (window-buffer *mouse-window*) - (mouse-lookup mouse-code)))) - (cond ((null form) - (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. - (error "Undefined mouse event: %s" - (prin1-to-string - (mouse-code-to-mouse-list mouse-code))))) - ((symbolp form) - (setq this-command form) - (funcall form *mouse-window* *mouse-x* *mouse-y*)) - ((listp form) - (setq this-command (car form)) - (eval form)) - (t - (error "Mouse action must be symbol or list, but was: %s" - form)))))) - ;; Don't let 'sun-mouse-handler get on last-command, - ;; since this function should be transparent. - (if (eq this-command 'sun-mouse-handler) - (setq this-command last-command)) - ;; (message (prin1-to-string this-command)) ; to see what your buttons did - nil) - -(defun sm::combined-hits () - "Read and return next mouse-hit, include possible double click" - (let ((hit1 (mouse-hit-read))) - (if (not (sm::hit-up-p hit1)) ; Up hits don't start doubles or chords. - (let ((hit2 (mouse-second-hit extra-click-wait))) - (if hit2 ; we cons'd it, we can smash it. - ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...)) - (setcar hit1 (logior (sm::hit-code hit1) - (sm::hit-code hit2) - (if (= (sm::hit-button hit1) - (sm::hit-button hit2)) - sm::DoubleBits 0)))))) - hit1)) - -(defun mouse-hit-read () - "Read mouse-hit list from keyboard. Like (read 'read-char), -but that uses minibuffer, and mucks up last-command." - (let ((char-list nil) (char nil)) - (while (not (equal 13 ; Carriage return. - (prog1 (setq char (read-char)) - (setq char-list (cons char char-list)))))) - (read (mapconcat 'char-to-string (nreverse char-list) "")) - )) - -;;; Second Click Hackery.... -;;; if prefix is not mouse-prefix, need a way to unread the char... -;;; or else have mouse flush input queue, or else need a peek at next char. - -;;; There is no peek, but since one character can be unread, we only -;;; have to flush the queue when the command after a mouse click -;;; starts with mouse-prefix1 (see below). -;;; Something to do later: We could buffer the read commands and -;;; execute them ourselves after doing the mouse command (using -;;; lookup-key ??). - -(defvar mouse-prefix1 24 ; C-x - "First char of mouse-prefix. Used to detect double clicks and chords.") - -(defvar mouse-prefix2 0 ; C-@ - "Second char of mouse-prefix. Used to detect double clicks and chords.") - - -(defun mouse-second-hit (hit-wait) - "Returns the next mouse hit occurring within HIT-WAIT milliseconds." - (if (sit-for-millisecs hit-wait) nil ; No input within hit-wait millisecs. - (let ((pc1 (read-char))) - (if (or (not (equal pc1 mouse-prefix1)) - (sit-for-millisecs 3)) ; a mouse prefix will have second char - ;; Can get away with one unread. - (progn (setq unread-command-events (list pc1)) - nil) ; Next input not mouse event. - (let ((pc2 (read-char))) - (if (not (equal pc2 mouse-prefix2)) - (progn (setq unread-command-events (list pc1)) ; put back the ^X -;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2)) -;;; Well, now we can, but I don't understand this code well enough to fix it... - (ding) ; user will have to retype that pc2. - nil) ; This input is not a mouse event. - ;; Next input has mouse prefix and is within time limit. - (let ((new-hit (mouse-hit-read))) ; Read the new hit. - (if (sm::hit-up-p new-hit) ; Ignore up events when timing. - (mouse-second-hit (- hit-wait (sm::hit-delta new-hit))) - new-hit ; New down hit within limit, return it. - )))))))) - -(defun sm::window-xy (x y) - "Find window containing screen coordinates X and Y. -Returns list (window x y) where x and y are relative to window." - (or - (catch 'found - (eval-in-windows - (let ((we (window-edges (selected-window)))) - (let ((le (nth 0 we)) - (te (nth 1 we)) - (re (nth 2 we)) - (be (nth 3 we))) - (if (= re (frame-width)) - ;; include the continuation column with this window - (setq re (1+ re))) - (if (= be (frame-height)) - ;; include partial line at bottom of frame with this window - ;; id est, if window is not multiple of char size. - (setq be (1+ be))) - - (if (and (>= x le) (< x re) - (>= y te) (< y be)) - (throw 'found - (list (selected-window) (- x le) (- y te)))))) - t)) ; include minibuffer in eval-in-windows - ;;If x,y from a real mouse click, we shouldn't get here. - (list nil x y) - )) - -(defun sm::window-region (loc) - "Parse LOC into a region symbol. -Returns one of (text scrollbar modeline minibuffer)" - (let ((w (sm::loc-w loc)) - (x (sm::loc-x loc)) - (y (sm::loc-y loc))) - (let ((right (1- (window-width w))) - (bottom (1- (window-height w)))) - (cond ((minibuffer-window-p w) 'minibuffer) - ((>= y bottom) 'modeline) - ((>= x right) 'scrollbar) - ;; far right column (window separator) is always a scrollbar - ((and scrollbar-width - ;; mouse within scrollbar-width of edge. - (>= x (- right scrollbar-width)) - ;; mouse a few chars past the end of line. - (>= x (+ 2 (window-line-end w x y)))) - 'scrollbar) - (t 'text))))) - -(defun window-line-end (w x y) - "Return WINDOW column (ignore X) containing end of line Y" - (eval-in-window w (save-excursion (move-to-loc (frame-width) y)))) - -;;; -;;; The encoding of mouse events into a mousemap. -;;; These values must agree with coding in emacstool: -;;; -(defconst sm::keyword-alist - '((left . 1) (middle . 2) (right . 4) - (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) - (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048) - )) - -(defun mouse-event-code (hit loc) - "Maps MOUSE-HIT and LOC into a mouse-code." -;;;Region is a code for one of text, modeline, scrollbar, or minibuffer. - (logior (sm::hit-code hit) - (mouse-region-to-code (sm::window-region loc)))) - -(defun mouse-region-to-code (region) - "Returns partial mouse-code for specified REGION." - (cdr (assq region sm::keyword-alist))) - -(defun mouse-list-to-mouse-code (mouse-list) - "Map a MOUSE-LIST to a mouse-code." - (apply 'logior - (mapcar (function (lambda (x) - (cdr (assq x sm::keyword-alist)))) - mouse-list))) - -(defun mouse-code-to-mouse-list (mouse-code) - "Map a MOUSE-CODE to a mouse-list." - (apply 'nconc (mapcar - (function (lambda (x) - (if (logtest mouse-code (cdr x)) - (list (car x))))) - sm::keyword-alist))) - -(defun mousemap-set (code mousemap value) - (let* ((alist (cdr mousemap)) - (assq-result (assq code alist))) - (if assq-result - (setcdr assq-result value) - (setcdr mousemap (cons (cons code value) alist))))) - -(defun mousemap-get (code mousemap) - (cdr (assq code (cdr mousemap)))) - -(defun mouse-lookup (mouse-code) - "Look up MOUSE-EVENT and return the definition. nil means undefined." - (or (mousemap-get mouse-code current-local-mousemap) - (mousemap-get mouse-code current-global-mousemap))) - -;;; -;;; I (jpeck) don't understand the utility of the next four functions -;;; ask Steven Greenbaum <froud@kestrel> -;;; -(defun mouse-mask-lookup (mask list) - "Args MASK (a bit mask) and LIST (a list of (code . form) pairs). -Returns a list of elements of LIST whose code or'ed with MASK is non-zero." - (let ((result nil)) - (while list - (if (logtest mask (car (car list))) - (setq result (cons (car list) result))) - (setq list (cdr list))) - result)) - -(defun mouse-union (l l-unique) - "Return the union of list of mouse (code . form) pairs L and L-UNIQUE, -where L-UNIQUE is considered to be union'ized already." - (let ((result l-unique)) - (while l - (let ((code-form-pair (car l))) - (if (not (assq (car code-form-pair) result)) - (setq result (cons code-form-pair result)))) - (setq l (cdr l))) - result)) - -(defun mouse-union-first-preferred (l1 l2) - "Return the union of lists of mouse (code . form) pairs L1 and L2, -based on the code's, with preference going to elements in L1." - (mouse-union l2 (mouse-union l1 nil))) - -(defun mouse-code-function-pairs-of-region (region) - "Return a list of (code . function) pairs, where each code is -currently set in the REGION." - (let ((mask (mouse-region-to-code region))) - (mouse-union-first-preferred - (mouse-mask-lookup mask (cdr current-local-mousemap)) - (mouse-mask-lookup mask (cdr current-global-mousemap)) - ))) - -;;; -;;; Functions for DESCRIBE-MOUSE-BINDINGS -;;; And other mouse documentation functions -;;; Still need a good procedure to print out a help sheet in readable format. -;;; - -(defun one-line-doc-string (function) - "Returns first line of documentation string for FUNCTION. -If there is no documentation string, then the string -\"No documentation\" is returned." - (while (consp function) (setq function (car function))) - (let ((doc (documentation function))) - (if (null doc) - "No documentation." - (string-match "^.*$" doc) - (substring doc 0 (match-end 0))))) - -(defun print-mouse-format (binding) - (princ (car binding)) - (princ ": ") - (mapcar (function - (lambda (mouse-list) - (princ mouse-list) - (princ " "))) - (cdr binding)) - (terpri) - (princ " ") - (princ (one-line-doc-string (car binding))) - (terpri) - ) - -(defun print-mouse-bindings (region) - "Prints mouse-event bindings for REGION." - (mapcar 'print-mouse-format (sm::event-bindings region))) - -(defun sm::event-bindings (region) - "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION, -where each mouse-list is bound to the function in REGION." - (let ((mouse-bindings (mouse-code-function-pairs-of-region region)) - (result nil)) - (while mouse-bindings - (let* ((code-function-pair (car mouse-bindings)) - (current-entry (assoc (cdr code-function-pair) result))) - (if current-entry - (setcdr current-entry - (cons (mouse-code-to-mouse-list (car code-function-pair)) - (cdr current-entry))) - (setq result (cons (cons (cdr code-function-pair) - (list (mouse-code-to-mouse-list - (car code-function-pair)))) - result)))) - (setq mouse-bindings (cdr mouse-bindings)) - ) - result)) - -(defun describe-mouse-bindings () - "Lists all current mouse-event bindings." - (interactive) - (with-output-to-temp-buffer "*Help*" - (princ "Text Region") (terpri) - (princ "---- ------") (terpri) - (print-mouse-bindings 'text) (terpri) - (princ "Modeline Region") (terpri) - (princ "-------- ------") (terpri) - (print-mouse-bindings 'modeline) (terpri) - (princ "Scrollbar Region") (terpri) - (princ "--------- ------") (terpri) - (print-mouse-bindings 'scrollbar))) - -(defun describe-mouse-briefly (mouse-list) - "Print a short description of the function bound to MOUSE-LIST." - (interactive "xDescribe mouse list briefly: ") - (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list)))) - (if function - (message "%s runs the command %s" mouse-list function) - (message "%s is undefined" mouse-list)))) - -(defun mouse-help-menu (function-and-binding) - (cons (prin1-to-string (car function-and-binding)) - (menu-create ; Two sub-menu items of form ("String" . nil) - (list (list (one-line-doc-string (car function-and-binding))) - (list (prin1-to-string (cdr function-and-binding))))))) - -(defun mouse-help-region (w x y &optional region) - "Displays a menu of mouse functions callable in this region." - (let* ((region (or region (sm::window-region (list w x y)))) - (mlist (mapcar (function mouse-help-menu) - (sm::event-bindings region))) - (menu (menu-create (cons (list (symbol-name region)) mlist))) - (item (sun-menu-evaluate w 0 y menu)) - ))) - -;;; -;;; Menu interface functions -;;; -;;; use defmenu, because this interface is subject to change -;;; really need a menu-p, but we use vectorp and the context... -;;; -(defun menu-create (items) - "Functional form for defmenu, given a list of ITEMS returns a menu. -Each ITEM is a (STRING . VALUE) pair." - (apply 'vector items) - ) - -(defmacro defmenu (menu &rest itemlist) - "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs. -See sun-menu-evaluate for interpretation of ITEMS." - (list 'defconst menu (funcall 'menu-create itemlist)) - ) - -(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu) - "Display a pop-up menu in WINDOW at X Y and evaluate selected item -of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. - A menu ITEM is a (STRING . FORM) pair; -the FORM associated with the selected STRING is evaluated, -and the resulting value is returned. Generally these FORMs are -evaluated for their side-effects rather than their values. - If the selected form is a menu or a symbol whose value is a menu, -then it is displayed and evaluated as a pullright menu item. - If the FORM of the first ITEM is nil, the STRING of the item -is used as a label for the menu, i.e. it's inverted and not selectable." - - (if (symbolp menu) (setq menu (symbol-value menu))) - (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu))) - -(defun sun-get-frame-data (code) - "Sends the tty-sub-window escape sequence CODE to terminal, -and returns a cons of the two numbers in returned escape sequence. -That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". -CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." - (send-string-to-terminal (concat "\033[" (int-to-string code) "t")) - (let (char str x y) - (while (not (equal 116 (setq char (read-char)))) ; #\t = 116 - (setq str (cons char str))) - (setq str (mapconcat 'char-to-string (nreverse str) "")) - (string-match ";[0-9]*" str) - (setq y (substring str (1+ (match-beginning 0)) (match-end 0))) - (setq str (substring str (match-end 0))) - (string-match ";[0-9]*" str) - (setq x (substring str (1+ (match-beginning 0)) (match-end 0))) - (cons (string-to-number y) (string-to-number x)))) - -(defun sm::font-size () - "Returns font size in pixels: (cons Ysize Xsize)" - (let ((pix (sun-get-frame-data 14)) ; returns size in pixels - (chr (sun-get-frame-data 18))) ; returns size in chars - (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr))))) - -(defvar sm::menu-kludge-x nil - "Cached frame-to-window X-Offset for sm::menu-kludge") -(defvar sm::menu-kludge-y nil - "Cached frame-to-window Y-Offset for sm::menu-kludge") - -(defun sm::menu-kludge () - "If sunfns.c uses <Menu_Base_Kludge> this function must be here!" - (or sm::menu-kludge-y - (let ((fs (sm::font-size))) - (setq sm::menu-kludge-y (+ 8 (car fs)) ; a title line and borders - sm::menu-kludge-x 4))) ; best values depend on .defaults/Menu - (let ((wl (sun-get-frame-data 13))) ; returns frame location - (cons (+ (car wl) sm::menu-kludge-y) - (+ (cdr wl) sm::menu-kludge-x)))) - -;;; -;;; Function interface to selection/region -;;; primitive functions are defined in sunfns.c -;;; -(defun sun-yank-selection () - "Set mark and yank the contents of the current sunwindows selection. -Insert contents into the current buffer at point." - (interactive "*") - (set-mark-command nil) - (insert (sun-get-selection))) - -(defun sun-select-region (beg end) - "Set the sunwindows selection to the region in the current buffer." - (interactive "r") - (sun-set-selection (buffer-substring beg end))) - -;;; -;;; Support for emacstool -;;; This closes the window instead of stopping emacs. -;;; -(defun suspend-emacstool (&optional stuffstring) - "Suspend emacstool. -If running under as a detached process emacstool, -you don't want to suspend (there is no way to resume), -just close the window, and wait for reopening." - (interactive) - (run-hooks 'suspend-hook) - (if stuffstring (send-string-to-terminal stuffstring)) - (send-string-to-terminal "\033[2t") ; To close EmacsTool window. - (run-hooks 'suspend-resume-hook)) - -(provide 'sun-mouse) -(provide 'term/sun-mouse) ; have to (require 'term/sun-mouse) - -;;; arch-tag: 6e879372-b899-4509-833f-d7f6250e309a -;;; sun-mouse.el ends here diff --git a/lisp/term/sun.el b/lisp/term/sun.el index ad364cbfb7a..54bb45a5c18 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -32,12 +32,12 @@ (defun scroll-down-in-place (n) (interactive "p") - (previous-line n) + (forward-line (- n)) (scroll-down n)) (defun scroll-up-in-place (n) (interactive "p") - (next-line n) + (forward-line n) (scroll-up n)) (defun kill-region-and-unmark (beg end) @@ -47,14 +47,6 @@ (setq this-command 'kill-region-and-unmark) (set-mark-command t)) -(defun select-previous-complex-command () - "Select Previous-complex-command" - (interactive) - (if (zerop (minibuffer-depth)) - (repeat-complex-command 1) - ;; FIXME: this function does not seem to exist. -stef'01 - (previous-complex-command 1))) - (defun rerun-prev-command () "Repeat Previous-complex-command." (interactive) @@ -93,7 +85,41 @@ ;; so we ignore them on the way down ;; -(defvar sun-raw-prefix (make-sparse-keymap)) +(defvar sun-raw-prefix + (let ((map (make-sparse-keymap))) + (define-key map "210z" [r3]) + (define-key map "213z" [r6]) + (define-key map "214z" [r7]) + (define-key map "216z" [r9]) + (define-key map "218z" [r11]) + (define-key map "220z" [r13]) + (define-key map "222z" [r15]) + (define-key map "193z" [redo]) + (define-key map "194z" [props]) + (define-key map "195z" [undo]) + ;; (define-key map "196z" 'ignore) ; Expose-down + ;; (define-key map "197z" [put]) + ;; (define-key map "198z" 'ignore) ; Open-down + ;; (define-key map "199z" [get]) + (define-key map "200z" [find]) + ;; (define-key map "201z" 'kill-region-and-unmark) ; Delete + (define-key map "224z" [f1]) + (define-key map "225z" [f2]) + (define-key map "226z" [f3]) + (define-key map "227z" [f4]) + (define-key map "228z" [f5]) + (define-key map "229z" [f6]) + (define-key map "230z" [f7]) + (define-key map "231z" [f8]) + (define-key map "232z" [f9]) + (define-key map "233z" [f10]) + (define-key map "234z" [f11]) + (define-key map "235z" [f12]) + (define-key map "A" [up]) ; R8 + (define-key map "B" [down]) ; R14 + (define-key map "C" [right]) ; R12 + (define-key map "D" [left]) ; R10 + map)) ;; Since .emacs gets loaded before this file, a hook is supplied ;; for you to put your own bindings in. @@ -102,88 +128,10 @@ "List of forms to evaluate after setting sun-raw-prefix.") -;;; This section adds definitions for the emacstool users -;; emacstool event filter converts function keys to C-x*{c}{lrt} -;; -;; for example the Open key (L7) would be encoded as "\C-x*gl" -;; the control, meta, and shift keys modify the character {lrt} -;; note that (unshifted) C-l is ",", C-r is "2", and C-t is "4" -;; -;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT. -;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys) -;; as ANSI escape sequences. Use the shell command -;; % setkeys noarrows -;; if you want these to come through for emacstool. -;; -;; If you are not using EmacsTool, -;; you can also use this by creating a .ttyswrc file to do the conversion. -;; but it won't include the CONTROL, META, or SHIFT keys! -;; -;; Important to define SHIFTed sequence before matching unshifted sequence. -;; (talk about bletcherous old uppercase terminal conventions!*$#@&%*&#$%) -;; this is worse than C-S/C-Q flow control anyday! -;; Do *YOU* run in capslock mode? -;; - -;; Note: al, el and gl are trapped by EmacsTool, so they never make it here. - -(defvar suntool-map (make-sparse-keymap) - "*Keymap for Emacstool bindings.") - - -;; Since .emacs gets loaded before this file, a hook is supplied -;; for you to put your own bindings in. - -(defvar suntool-map-hooks nil - "List of forms to evaluate after setting suntool-map.") - -;; -;; If running under emacstool, arrange to call suspend-emacstool -;; instead of suspend-emacs. -;; -;; First mouse blip is a clue that we are in emacstool. -;; -;; C-x C-@ is the mouse command prefix. - -(autoload 'sun-mouse-handler "sun-mouse" - "Sun Emacstool handler for mouse blips (not loaded)." t) (defun terminal-init-sun () "Terminal initialization function for sun." - (define-key function-key-map "\e[" sun-raw-prefix) - - (define-key sun-raw-prefix "210z" [r3]) - (define-key sun-raw-prefix "213z" [r6]) - (define-key sun-raw-prefix "214z" [r7]) - (define-key sun-raw-prefix "216z" [r9]) - (define-key sun-raw-prefix "218z" [r11]) - (define-key sun-raw-prefix "220z" [r13]) - (define-key sun-raw-prefix "222z" [r15]) - (define-key sun-raw-prefix "193z" [redo]) - (define-key sun-raw-prefix "194z" [props]) - (define-key sun-raw-prefix "195z" [undo]) - ;; (define-key sun-raw-prefix "196z" 'ignore) ; Expose-down - ;; (define-key sun-raw-prefix "197z" [put]) - ;; (define-key sun-raw-prefix "198z" 'ignore) ; Open-down - ;; (define-key sun-raw-prefix "199z" [get]) - (define-key sun-raw-prefix "200z" [find]) - ;; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark) ; Delete - (define-key sun-raw-prefix "224z" [f1]) - (define-key sun-raw-prefix "225z" [f2]) - (define-key sun-raw-prefix "226z" [f3]) - (define-key sun-raw-prefix "227z" [f4]) - (define-key sun-raw-prefix "228z" [f5]) - (define-key sun-raw-prefix "229z" [f6]) - (define-key sun-raw-prefix "230z" [f7]) - (define-key sun-raw-prefix "231z" [f8]) - (define-key sun-raw-prefix "232z" [f9]) - (define-key sun-raw-prefix "233z" [f10]) - (define-key sun-raw-prefix "234z" [f11]) - (define-key sun-raw-prefix "235z" [f12]) - (define-key sun-raw-prefix "A" [up]) ; R8 - (define-key sun-raw-prefix "B" [down]) ; R14 - (define-key sun-raw-prefix "C" [right]) ; R12 - (define-key sun-raw-prefix "D" [left]) ; R10 + (define-key input-decode-map "\e[" sun-raw-prefix) (global-set-key [r3] 'backward-page) (global-set-key [r6] 'forward-page) @@ -207,77 +155,7 @@ (let ((hooks sun-raw-prefix-hooks)) (while hooks (eval (car hooks)) - (setq hooks (cdr hooks))))) - - (define-key suntool-map "gr" 'beginning-of-buffer) ; r7 - (define-key suntool-map "iR" 'backward-page) ; R9 - (define-key suntool-map "ir" 'scroll-down) ; r9 - (define-key suntool-map "kr" 'recenter) ; r11 - (define-key suntool-map "mr" 'end-of-buffer) ; r13 - (define-key suntool-map "oR" 'forward-page) ; R15 - (define-key suntool-map "or" 'scroll-up) ; r15 - (define-key suntool-map "b\M-L" 'rerun-prev-command) ; M-AGAIN - (define-key suntool-map "b\M-l" 'prev-complex-command) ; M-Again - (define-key suntool-map "bl" 'redraw-display) ; Again - (define-key suntool-map "cl" 'list-buffers) ; Props - (define-key suntool-map "dl" 'undo) ; Undo - (define-key suntool-map "el" 'ignore) ; Expose-Open - (define-key suntool-map "fl" 'sun-select-region) ; Put - (define-key suntool-map "f," 'copy-region-as-kill) ; C-Put - (define-key suntool-map "gl" 'ignore) ; Open-Open - (define-key suntool-map "hl" 'sun-yank-selection) ; Get - (define-key suntool-map "h," 'yank) ; C-Get - (define-key suntool-map "il" 'research-forward) ; Find - (define-key suntool-map "i," 're-search-forward) ; C-Find - (define-key suntool-map "i\M-l" 'research-backward) ; M-Find - (define-key suntool-map "i\M-," 're-search-backward) ; C-M-Find - - (define-key suntool-map "jL" 'yank) ; DELETE - (define-key suntool-map "jl" 'kill-region-and-unmark) ; Delete - (define-key suntool-map "j\M-l" 'exchange-point-and-mark) ; M-Delete - (define-key suntool-map "j," - (lambda () (interactive) (pop-mark))) ; C-Delete - - (define-key suntool-map "fT" 'shrink-window-horizontally) ; T6 - (define-key suntool-map "gT" 'enlarge-window-horizontally) ; T7 - (define-key suntool-map "ft" 'shrink-window) ; t6 - (define-key suntool-map "gt" 'enlarge-window) ; t7 - (define-key suntool-map "cT" (lambda (n) (interactive "p") (scroll-down n))) - (define-key suntool-map "dT" (lambda (n) (interactive "p") (scroll-up n))) - (define-key suntool-map "ct" 'scroll-down-in-place) ; t3 - (define-key suntool-map "dt" 'scroll-up-in-place) ; t4 - (define-key ctl-x-map "*" suntool-map) - - (when suntool-map-hooks - (message "suntool-map-hooks is obsolete! Use term-setup-hook instead!") - (let ((hooks suntool-map-hooks)) - (while hooks - (eval (car hooks)) - (setq hooks (cdr hooks))))) - - (define-key ctl-x-map "\C-@" 'sun-mouse-once)) - -(defun emacstool-init () - "Set up Emacstool window, if you know you are in an emacstool." - ;; Make sure sun-mouse and sun-fns are loaded. - (require 'sun-fns) - (define-key ctl-x-map "\C-@" 'sun-mouse-handler) - - ;; FIXME: this function does not seem to exist either. -stef'01 - (if (< (sun-window-init) 0) - (message "Not a Sun Window") - (progn - (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map) - (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map) - (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map)) - (send-string-to-terminal - (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\")))) - -(defun sun-mouse-once () - "Converts to emacstool and sun-mouse-handler on first mouse hit." - (interactive) - (emacstool-init) - (sun-mouse-handler)) ; Now, execute this mouse blip. + (setq hooks (cdr hooks)))))) -;;; arch-tag: db761d47-fd7d-42b4-aae1-04fa116b6ba6 +;; arch-tag: db761d47-fd7d-42b4-aae1-04fa116b6ba6 ;;; sun.el ends here diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index 1eaf693995e..c314d4fada7 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -815,8 +815,6 @@ Value is the modified color alist for FRAME." "Register the default set of colors for a character terminal." (let* ((colors (cond ((eq window-system 'pc) msdos-color-values) - ((eq system-type 'windows-nt) - w32-tty-standard-colors) (t tty-standard-colors))) (color (car colors))) (while colors diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index b15a556dea6..c40b201d0b5 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -29,86 +29,80 @@ ;;; Code: +(defvar tvi970-terminal-map + (let ((map (make-sparse-keymap))) + + ;; Miscellaneous keys + (dolist (key-binding + '(;; These are set up by termcap or terminfo + ;; ("\eOP" [kp-f1]) + ;; ("\eOQ" [kp-f2]) + ;; ("\eOR" [kp-f3]) + ;; ("\eOS" [kp-f4]) + + ;; These might bre set by terminfo. + ("\e[H" [home]) + ("\e[Z" [backtab]) + ("\e[i" [print]) + ("\e[@" [insert]) + ("\e[L" [insertline]) + ("\e[M" [deleteline]) + ("\e[U" [next]) ;; actually the `page' key + + ;; These won't be set up by either + ("\eOm" [kp-subtract]) + ("\eOl" [kp-separator]) + ("\eOn" [kp-decimal]) + ("\eOM" [kp-enter]) + + ;; These won't be set up by either either + ("\e[K" [key_eol]) ;; Not an X keysym + ("\e[J" [key_eos]) ;; Not an X keysym + ("\e[2J" [key_clear]) ;; Not an X keysym + ("\e[P" [key_dc]) ;; Not an X keysym + ("\e[g" [S-tab]) ;; Not an X keysym + ("\e[2N" [clearentry]) ;; Not an X keysym + ("\e[2K" [S-clearentry]) ;; Not an X keysym + ("\e[E" [?\C-j]) ;; Not an X keysym + ("\e[g" [S-backtab]) ;; Not an X keysym + ("\e[?1i" [key_sprint]) ;; Not an X keysym + ("\e[4h" [key_sic]) ;; Not an X keysym + ("\e[4l" [S-delete]) ;; Not an X keysym + ("\e[Q" [S-insertline]) ;; Not an X keysym + ("\e[1Q" [key_sdl]) ;; Not an X keysym + ("\e[19l" [key_seol]) ;; Not an X keysym + ("\e[19h" [S-erasepage]) ;; Not an X keysym + ("\e[V" [S-page]) ;; Not an X keysym + ("\eS" [send]) ;; Not an X keysym + ("\e5" [S-send]) ;; Not an X keysym + )) + (define-key map (car key-binding) (nth 1 key-binding))) + + + ;; The numeric keypad keys. + (dotimes (i 10) + (define-key map (format "\eO%c" (+ i ?p)) + (vector (intern (format "kp-%d" i))))) + ;; The numbered function keys. + (dotimes (i 16) + (define-key map (format "\e?%c" (+ i ?a)) + (vector (intern (format "f%d" (1+ i))))) + (define-key map (format "\e?%c" (+ i ?A)) + (vector (intern (format "S-f%d" (1+ i)))))) + map)) + (defun terminal-init-tvi970 () "Terminal initialization function for tvi970." - (or (lookup-key function-key-map "\e[") - (define-key function-key-map "\e[" (make-keymap))) - ;; (or (lookup-key function-key-map "\eO") - ;; (define-key function-key-map "\eO" (make-keymap))) - - ;; Miscellaneous keys - (mapcar (function (lambda (key-binding) - (define-key function-key-map - (car key-binding) (nth 1 key-binding)))) - '( - ;; These are set up by termcap or terminfo - ;; ("\eOP" [kp-f1]) - ;; ("\eOQ" [kp-f2]) - ;; ("\eOR" [kp-f3]) - ;; ("\eOS" [kp-f4]) - - ;; These might br set by terminfo - ("\e[H" [home]) - ("\e[Z" [backtab]) - ("\e[i" [print]) - ("\e[@" [insert]) - ("\e[L" [insertline]) - ("\e[M" [deleteline]) - ("\e[U" [next]) ;; actually the `page' key - - ;; These won't be set up by either - ("\eOm" [kp-subtract]) - ("\eOl" [kp-separator]) - ("\eOn" [kp-decimal]) - ("\eOM" [kp-enter]) - - ;; These won't be set up by either either - ("\e[K" [key_eol]) ;; Not an X keysym - ("\e[J" [key_eos]) ;; Not an X keysym - ("\e[2J" [key_clear]) ;; Not an X keysym - ("\e[P" [key_dc]) ;; Not an X keysym - ("\e[g" [S-tab]) ;; Not an X keysym - ("\e[2N" [clearentry]) ;; Not an X keysym - ("\e[2K" [S-clearentry]) ;; Not an X keysym - ("\e[E" [?\C-j]) ;; Not an X keysym - ("\e[g" [S-backtab]) ;; Not an X keysym - ("\e[?1i" [key_sprint]) ;; Not an X keysym - ("\e[4h" [key_sic]) ;; Not an X keysym - ("\e[4l" [S-delete]) ;; Not an X keysym - ("\e[Q" [S-insertline]) ;; Not an X keysym - ("\e[1Q" [key_sdl]) ;; Not an X keysym - ("\e[19l" [key_seol]) ;; Not an X keysym - ("\e[19h" [S-erasepage]) ;; Not an X keysym - ("\e[V" [S-page]) ;; Not an X keysym - ("\eS" [send]) ;; Not an X keysym - ("\e5" [S-send]) ;; Not an X keysym - )) - - ;; The numeric keypad keys. - (let ((i 0)) - (while (< i 10) - (define-key function-key-map - (format "\eO%c" (+ i ?p)) - (vector (intern (format "kp-%d" i)))) - (setq i (1+ i)))) - ;; The numbered function keys. - (let ((i 0)) - (while (< i 16) - (define-key function-key-map - (format "\e?%c" (+ i ?a)) - (vector (intern (format "f%d" (1+ i))))) - (define-key function-key-map - (format "\e?%c" (+ i ?A)) - (vector (intern (format "S-f%d" (1+ i))))) - (setq i (1+ i)))) - + ;; Use inheritance to let the main keymap override these defaults. + ;; This way we don't override terminfo-derived settings or settings + ;; made in the .emacs file. + (let ((m (copy-keymap tvi970-terminal-map))) + (set-keymap-parent m (keymap-parent input-decode-map)) + (set-keymap-parent input-decode-map m)) (tvi970-set-keypad-mode 1)) - -;;; Should keypad numbers send ordinary digits or distinct escape sequences? -(defvar tvi970-keypad-numeric nil - "Non-nil means the terminal should be in numeric keypad mode. -Do not set this variable! Call the function `tvi970-set-keypad-mode'.") + +;; Should keypad numbers send ordinary digits or distinct escape sequences? (defun tvi970-set-keypad-mode (&optional arg) "Set the current mode of the TVI 970 numeric keypad. In ``numeric keypad mode'', the number keys on the keypad act as @@ -119,11 +113,11 @@ With no argument, toggle between the two possible modes. With a positive argument, select alternate keypad mode. With a negative argument, select numeric keypad mode." (interactive "P") - (setq tvi970-keypad-numeric - (if (null arg) - (not tvi970-keypad-numeric) - (> (prefix-numeric-value arg) 0))) - (send-string-to-terminal (if tvi970-keypad-numeric "\e=" "\e>"))) + (let ((newval (if (null arg) + (not (terminal-parameter nil 'tvi970-keypad-numeric)) + (> (prefix-numeric-value arg) 0)))) + (set-terminal-parameter nil 'tvi970-keypad-numeric newval) + (send-string-to-terminal (if newval "\e=" "\e>")))) -;;; arch-tag: c1334cf0-1462-41c3-a963-c077d175f8f0 +;; arch-tag: c1334cf0-1462-41c3-a963-c077d175f8f0 ;;; tvi970.el ends here diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index e7333ec191a..10a15619f84 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -38,10 +38,9 @@ ;; Set up function-key-map entries that termcap and terminfo don't know. - (defun terminal-init-vt100 () "Terminal initialization function for vt100." - (load "term/lk201" nil t)) + (tty-run-terminal-initialization (selected-frame) "lk201")) ;;; Controlling the screen width. (defvar vt100-wide-mode (= (frame-width) 132) diff --git a/lisp/term/vt102.el b/lisp/term/vt102.el index ad780ed5081..67a90a8242c 100644 --- a/lisp/term/vt102.el +++ b/lisp/term/vt102.el @@ -1,8 +1,8 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-vt102 () - "Terminal initialization function for vt102." - (load "term/vt100" nil t)) + "Terminal initialization function for vt102." + (tty-run-terminal-initialization (selected-frame) "vt100")) ;;; arch-tag: 6e839cfc-125a-4574-82f1-c23a51f7c50f ;;; vt102.el ends here diff --git a/lisp/term/vt125.el b/lisp/term/vt125.el index 2221e597aed..82a7047fef1 100644 --- a/lisp/term/vt125.el +++ b/lisp/term/vt125.el @@ -1,8 +1,8 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-vt125 () - "Terminal initialization function for vt125." - (load "term/vt100" nil t)) + "Terminal initialization function for vt125." + (tty-run-terminal-initialization (selected-frame) "vt100")) ;;; arch-tag: 1d92d70f-dd55-4a1d-9088-e215a4883801 ;;; vt125.el ends here diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el index e1215d15023..78c65c084ce 100644 --- a/lisp/term/vt200.el +++ b/lisp/term/vt200.el @@ -1,12 +1,12 @@ ;; -*- no-byte-compile: t -*- ;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. - (defun terminal-init-vt200 () - "Terminal initialization function for vt200." - (load "term/vt100" nil t) + "Terminal initialization function for vt200." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: 0f78f583-9f32-4237-b106-28bcfff21d89 +;; arch-tag: 0f78f583-9f32-4237-b106-28bcfff21d89 ;;; vt200.el ends here diff --git a/lisp/term/vt201.el b/lisp/term/vt201.el index 315030ab687..987aee09f3b 100644 --- a/lisp/term/vt201.el +++ b/lisp/term/vt201.el @@ -2,10 +2,11 @@ ;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (defun terminal-init-vt201 () - "Terminal initialization function for vt201." - (load "term/vt100" nil t) + "Terminal initialization function for vt201." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: a6abb38f-60ea-449e-a9e9-3fb8572c52ae +;; arch-tag: a6abb38f-60ea-449e-a9e9-3fb8572c52ae ;;; vt201.el ends here diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el index cccd2a6dfb7..f9439e0eff7 100644 --- a/lisp/term/vt220.el +++ b/lisp/term/vt220.el @@ -2,10 +2,11 @@ ;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (defun terminal-init-vt220 () - "Terminal initialization function for vt220." - (load "term/vt100" nil t) + "Terminal initialization function for vt220." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: 98fc4867-a20d-46a1-a276-d7be31e49871 +;; arch-tag: 98fc4867-a20d-46a1-a276-d7be31e49871 ;;; vt220.el ends here diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el index bb3931edac8..0aea10bf982 100644 --- a/lisp/term/vt240.el +++ b/lisp/term/vt240.el @@ -2,10 +2,11 @@ ;; For our purposes we can treat the vt200 and vt100 almost alike. ;; Most differences are handled by the termcap entry. (defun terminal-init-vt240 () - "Terminal initialization function for vt240." - (load "term/vt100" nil t) + "Terminal initialization function for vt240." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: d9f88e9c-02dc-49ff-871c-a415f08e4eb7 +;; arch-tag: d9f88e9c-02dc-49ff-871c-a415f08e4eb7 ;;; vt240.el ends here diff --git a/lisp/term/vt300.el b/lisp/term/vt300.el index ff600f47a1e..d19f847588b 100644 --- a/lisp/term/vt300.el +++ b/lisp/term/vt300.el @@ -1,9 +1,10 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-vt300 () - "Terminal initialization function for vt300." - (load "term/vt100" nil t) + "Terminal initialization function for vt300." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: 876831c9-a6f2-444a-b033-706e6fbc149f +;; arch-tag: 876831c9-a6f2-444a-b033-706e6fbc149f ;;; vt300.el ends here diff --git a/lisp/term/vt320.el b/lisp/term/vt320.el index fb7772c7b5b..1d36c9d933a 100644 --- a/lisp/term/vt320.el +++ b/lisp/term/vt320.el @@ -1,9 +1,10 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-vt320 () - "Terminal initialization function for vt320." - (load "term/vt100" nil t) + "Terminal initialization function for vt320." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: f9f4c954-0b9e-45f9-b450-a320d32abd9c +;; arch-tag: f9f4c954-0b9e-45f9-b450-a320d32abd9c ;;; vt320.el ends here diff --git a/lisp/term/vt400.el b/lisp/term/vt400.el index 97c0c5d7372..78af2a37197 100644 --- a/lisp/term/vt400.el +++ b/lisp/term/vt400.el @@ -1,9 +1,10 @@ ;; -*- no-byte-compile: t -*- (defun terminal-init-vt400 () - "Terminal initialization function for vt400." - (load "term/vt100" nil t) + "Terminal initialization function for vt400." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: a70809c5-6b21-42cc-ba20-536683e5e7d5 +;; arch-tag: a70809c5-6b21-42cc-ba20-536683e5e7d5 ;;; vt400.el ends here diff --git a/lisp/term/vt420.el b/lisp/term/vt420.el index 65ffa759c17..6547557950a 100644 --- a/lisp/term/vt420.el +++ b/lisp/term/vt420.el @@ -1,9 +1,10 @@ ;; -*- no-byte-compile: t -*- -(defun terminal-init-vt420 () - "Terminal initialization function for vt420." - (load "term/vt100" nil t) +(defun terminal-init-vt420 + "Terminal initialization function for vt420." + (tty-run-terminal-initialization (selected-frame) "vt100") ;; Make F11 an escape key. - (define-key function-key-map "\e[23~" [?\e])) + (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. + (define-key local-function-key-map [f11] [?\e])) -;;; arch-tag: df2f897c-3a12-4b3c-9259-df089f96c160 +;; arch-tag: df2f897c-3a12-4b3c-9259-df089f96c160 ;;; vt420.el ends here diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 16edd55f5a4..066093f3a32 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -68,8 +68,8 @@ ;; An alist of X options and the function which handles them. See ;; ../startup.el. -(if (not (eq window-system 'w32)) - (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name))) +;; (if (not (eq window-system 'w32)) +;; (error "%s: Loading w32-win.el but not compiled for w32" (invocation-name))) (require 'frame) (require 'mouse) @@ -79,8 +79,18 @@ (require 'menu-bar) (require 'dnd) (require 'code-pages) +(require 'w32-vars) + +;; Keep an obsolete alias for w32-focus-frame in case it is used by code +;; outside Emacs. +(define-obsolete-function-alias 'w32-focus-frame 'x-focus-frame "23.1") (defvar xlfd-regexp-registry-subnum) +(defvar w32-color-map) ;; defined in w32fns.c + +(declare-function w32-send-sys-command "w32fns.c") +(declare-function w32-select-font "w32fns.c") +(declare-function set-message-beep "w32console.c") ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles (if (fboundp 'new-fontset) @@ -89,9 +99,6 @@ ;; The following definition is used for debugging scroll bar events. ;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event)) -;; Handle mouse-wheel events with mwheel. -(mouse-wheel-mode 1) - (defun w32-drag-n-drop-debug (event) "Print the drag-n-drop EVENT in a readable form." (interactive "e") @@ -111,7 +118,7 @@ Switch to a buffer editing the last file dropped." (y (cdr coords))) (if (and (> x 0) (> y 0)) (set-frame-selected-window nil window)) - (mapcar (lambda (file-name) + (mapc (lambda (file-name) (let ((f (subst-char-in-string ?\\ ?/ file-name)) (coding (or file-name-coding-system default-file-name-coding-system))) @@ -1039,58 +1046,19 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;;; Function keys -;;; make f10 activate the real menubar rather than the mini-buffer menu -;;; navigation feature. -(defun menu-bar-open (&optional frame) - "Start key navigation of the menu bar in FRAME. - -This initially activates the first menu-bar item, and you can then navigate -with the arrow keys, select a menu entry with the Return key or cancel with -the Escape key. If FRAME has no menu bar, this function does nothing. - -If FRAME is nil or not given, use the selected frame." - (interactive "i") - (w32-send-sys-command ?\xf100 frame)) -; -(global-set-key [f10] 'menu-bar-open) - -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - -(define-key function-key-map [S-tab] [backtab]) - + ;;; make f10 activate the real menubar rather than the mini-buffer menu + ;;; navigation feature. + (defun menu-bar-open (&optional frame) + "Start key navigation of the menu bar in FRAME. + + This initially activates the first menu-bar item, and you can then navigate + with the arrow keys, select a menu entry with the Return key or cancel with + the Escape key. If FRAME has no menu bar, this function does nothing. + + If FRAME is nil or not given, use the selected frame." + (interactive "i") + (w32-send-sys-command ?\xf100 frame)) -;;; Do the actual Windows setup here; the above code just defines -;;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) - -;;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (setq x-resource-name - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (replace-regexp-in-string "[.*]" "-" (invocation-name)))) - -;; For the benefit of older Emacses (19.27 and earlier) that are sharing -;; the same lisp directory, don't pass the third argument unless we seem -;; to have the multi-display support. -(if (fboundp 'x-close-connection) - (x-open-connection "" - x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t) - (x-open-connection "" - x-command-line-resources)) - -(setq frame-creation-function 'x-create-frame-with-faces) - -(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - -;; W32 expects the menu bar cut and paste commands to use the clipboard. -;; This has ,? to match both on Sunos and on Solaris. -(menu-bar-enable-clipboard) ;; W32 systems have different fonts than commonly found on X, so ;; we define our own standard fontset here. @@ -1103,120 +1071,10 @@ European languages which are distributed with Windows as See the documentation of `create-fontset-from-fontset-spec' for the format.") -;; Conditional on new-fontset so bootstrapping works on non-GUI compiles -(if (fboundp 'new-fontset) - (progn - ;; Setup the default fontset. - (setup-default-fontset) - ;; Enable Japanese fonts on Windows to be used by default. - (set-fontset-font nil (make-char 'katakana-jisx0201) - '("*" . "JISX0208-SJIS")) - (set-fontset-font nil (make-char 'latin-jisx0201) - '("*" . "JISX0208-SJIS")) - (set-fontset-font nil (make-char 'japanese-jisx0208) - '("*" . "JISX0208-SJIS")) - (set-fontset-font nil (make-char 'japanese-jisx0208-1978) - '("*" . "JISX0208-SJIS")) - ;; Create the standard fontset. - (create-fontset-from-fontset-spec w32-standard-fontset-spec t) - ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). - (create-fontset-from-x-resource) - ;; Try to create a fontset from a font specification which comes - ;; from initial-frame-alist, default-frame-alist, or X resource. - ;; A font specification in command line argument (i.e. -fn XXXX) - ;; should be already in default-frame-alist as a `font' - ;; parameter. However, any font specifications in site-start - ;; library, user's init file (.emacs), and default.el are not - ;; yet handled here. - - (let ((font (or (cdr (assq 'font initial-frame-alist)) - (cdr (assq 'font default-frame-alist)) - (x-get-resource "font" "Font"))) - xlfd-fields resolved-name) - (if (and font - (not (query-fontset font)) - (setq resolved-name (x-resolve-font-name font)) - (setq xlfd-fields (x-decompose-font-name font))) - (if (string= "fontset" - (aref xlfd-fields xlfd-regexp-registry-subnum)) - (new-fontset font - (x-complement-fontset-spec xlfd-fields nil)) - ;; Create a fontset from FONT. The fontset name is - ;; generated from FONT. - (create-fontset-from-ascii-font font - resolved-name "startup")))))) - -;; Apply a geometry resource to the initial frame. Put it at the end -;; of the alist, so that anything specified on the command line takes -;; precedence. -(let* ((res-geometry (x-get-resource "geometry" "Geometry")) - parsed) - (if res-geometry - (progn - (setq parsed (x-parse-geometry res-geometry)) - ;; If the resource specifies a position, - ;; call the position and size "user-specified". - (if (or (assq 'top parsed) (assq 'left parsed)) - (setq parsed (cons '(user-position . t) - (cons '(user-size . t) parsed)))) - ;; All geometry parms apply to the initial frame. - (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. - (if (assq 'height parsed) - (push (cons 'height (cdr (assq 'height parsed))) - default-frame-alist)) - (if (assq 'width parsed) - (push (cons 'width (cdr (assq 'width parsed))) - default-frame-alist))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (push '(reverse . t) default-frame-alist)))) - (defun x-win-suspend-error () "Report an error when a suspend is attempted." (error "Suspending an Emacs running under W32 makes no sense")) -(add-hook 'suspend-hook 'x-win-suspend-error) - -;;; Turn off window-splitting optimization; w32 is usually fast enough -;;; that this is only annoying. -(setq split-window-keep-point t) - -;; Don't show the frame name; that's redundant. -(setq-default mode-line-frame-identification " ") - -;;; Set to a system sound if you want a fancy bell. -(set-message-beep 'ok) - -;; Remap some functions to call w32 common dialogs - -(defun internal-face-interactive (what &optional bool) - (let* ((fn (intern (concat "face-" what))) - (prompt (concat "Set " what " of face ")) - (face (read-face-name prompt)) - (default (if (fboundp fn) - (or (funcall fn face (selected-frame)) - (funcall fn 'default (selected-frame))))) - (fn-win (intern (concat (symbol-name window-system) "-select-" what))) - value) - (setq value - (cond ((fboundp fn-win) - (funcall fn-win)) - ((eq bool 'color) - (completing-read (concat prompt " " (symbol-name face) " to: ") - (mapcar (function (lambda (color) - (cons color color))) - x-colors) - nil nil nil nil default)) - (bool - (y-or-n-p (concat "Should face " (symbol-name face) - " be " bool "? "))) - (t - (read-string (concat prompt " " (symbol-name face) " to: ") - nil nil default)))) - (list face (if (equal value "") nil value)))) + (defun mouse-set-font (&rest fonts) "Select an Emacs font from a list of known good fonts and fontsets. @@ -1257,7 +1115,131 @@ pop-up menu are unaffected by `w32-list-proportional-fonts')." (png "libpng13d.dll" "libpng13.dll" "libpng12d.dll" "libpng12.dll" "libpng.dll") (jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll") (tiff "libtiff3.dll" "libtiff.dll") - (gif "giflib4.dll" "libungif4.dll" "libungif.dll"))) + (gif "giflib4.dll" "libungif4.dll" "libungif.dll") + (svg "librsvg-2-2.dll") + (gdk-pixbuf "libgdk_pixbuf-2.0-0.dll") + (glib "libglib-2.0-0.dll"))) + +;;; multi-tty support +(defvar w32-initialized nil + "Non-nil if the w32 window system has been initialized.") + +(defun w32-initialize-window-system () + "Initialize Emacs for W32 GUI frames." + + ;; Do the actual Windows setup here; the above code just defines + ;; functions and variables that we use now. + + (setq command-line-args (x-handle-args command-line-args)) + + ;; Make sure we have a valid resource name. + (or (stringp x-resource-name) + (setq x-resource-name + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (replace-regexp-in-string "[.*]" "-" (invocation-name)))) + + (x-open-connection "" x-command-line-resources + ;; Exit with a fatal error if this fails and we + ;; are the initial display + (eq initial-window-system 'w32)) + + ;; Setup the default fontset. + (setup-default-fontset) + + ;; Enable Japanese fonts on Windows to be used by default. + (set-fontset-font nil (make-char 'katakana-jisx0201) + '("*" . "JISX0208-SJIS")) + (set-fontset-font nil (make-char 'latin-jisx0201) + '("*" . "JISX0208-SJIS")) + (set-fontset-font nil (make-char 'japanese-jisx0208) + '("*" . "JISX0208-SJIS")) + (set-fontset-font nil (make-char 'japanese-jisx0208-1978) + '("*" . "JISX0208-SJIS")) + + ;; Create the standard fontset. + (create-fontset-from-fontset-spec w32-standard-fontset-spec t) + ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...). + (create-fontset-from-x-resource) + ;; Try to create a fontset from a font specification which comes + ;; from initial-frame-alist, default-frame-alist, or X resource. + ;; A font specification in command line argument (i.e. -fn XXXX) + ;; should be already in default-frame-alist as a `font' + ;; parameter. However, any font specifications in site-start + ;; library, user's init file (.emacs), and default.el are not + ;; yet handled here. + + (let ((font (or (cdr (assq 'font initial-frame-alist)) + (cdr (assq 'font default-frame-alist)) + (x-get-resource "font" "Font"))) + xlfd-fields resolved-name) + (if (and font + (not (query-fontset font)) + (setq resolved-name (x-resolve-font-name font)) + (setq xlfd-fields (x-decompose-font-name font))) + (if (string= "fontset" + (aref xlfd-fields xlfd-regexp-registry-subnum)) + (new-fontset font + (x-complement-fontset-spec xlfd-fields nil)) + ;; Create a fontset from FONT. The fontset name is + ;; generated from FONT. + (create-fontset-from-ascii-font font + resolved-name "startup")))) + + ;; Apply a geometry resource to the initial frame. Put it at the end + ;; of the alist, so that anything specified on the command line takes + ;; precedence. + (let* ((res-geometry (x-get-resource "geometry" "Geometry")) + parsed) + (if res-geometry + (progn + (setq parsed (x-parse-geometry res-geometry)) + ;; If the resource specifies a position, + ;; call the position and size "user-specified". + (if (or (assq 'top parsed) (assq 'left parsed)) + (setq parsed (cons '(user-position . t) + (cons '(user-size . t) parsed)))) + ;; All geometry parms apply to the initial frame. + (setq initial-frame-alist (append initial-frame-alist parsed)) + ;; The size parms apply to all frames. + (if (assq 'height parsed) + (push (cons 'height (cdr (assq 'height parsed))) + default-frame-alist)) + (if (assq 'width parsed) + (push (cons 'width (cdr (assq 'width parsed))) + default-frame-alist))))) + + ;; Check the reverseVideo resource. + (let ((case-fold-search t)) + (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) + (if (and rv (string-match "^\\(true\\|yes\\|on\\)$" rv)) + (push '(reverse . t) default-frame-alist)))) + + ;; Don't let Emacs suspend under w32 gui + (add-hook 'suspend-hook 'x-win-suspend-error) + + ;; Turn off window-splitting optimization; w32 is usually fast enough + ;; that this is only annoying. + (setq split-window-keep-point t) + + ;; Turn on support for mouse wheels + (mouse-wheel-mode 1) + + ;; W32 expects the menu bar cut and paste commands to use the clipboard. + (menu-bar-enable-clipboard) + + ;; Don't show the frame name; that's redundant. + (setq-default mode-line-frame-identification " ") + + ;; Set to a system sound if you want a fancy bell. + (set-message-beep 'ok) + (setq w32-initialized t)) + +(add-to-list 'handle-args-function-alist '(w32 . x-handle-args)) +(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces)) +(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system)) + +(provide 'w32-win) ;; arch-tag: 69fb1701-28c2-4890-b351-3d1fe4b4f166 ;;; w32-win.el ends here diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el new file mode 100644 index 00000000000..f45d7e0ad7a --- /dev/null +++ b/lisp/term/w32console.el @@ -0,0 +1,65 @@ +;;; w32console.el -- Setup w32 console keys and colors. + +;; Copyright (C) 2007 Free Software Foundation, Inc. + +;; Author: FSF +;; Keywords: terminals + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; 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 +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Code: + +;; W32 uses different color indexes than standard: + +(defvar w32-tty-standard-colors + '(("black" 0 0 0 0) + ("blue" 1 0 0 52480) ; MediumBlue + ("green" 2 8704 35584 8704) ; ForestGreen + ("cyan" 3 0 52736 53504) ; DarkTurquoise + ("red" 4 45568 8704 8704) ; FireBrick + ("magenta" 5 35584 0 35584) ; DarkMagenta + ("brown" 6 40960 20992 11520) ; Sienna + ("lightgray" 7 48640 48640 48640) ; Gray + ("darkgray" 8 26112 26112 26112) ; Gray40 + ("lightblue" 9 0 0 65535) ; Blue + ("lightgreen" 10 0 65535 0) ; Green + ("lightcyan" 11 0 65535 65535) ; Cyan + ("lightred" 12 65535 0 0) ; Red + ("lightmagenta" 13 65535 0 65535) ; Magenta + ("yellow" 14 65535 65535 0) ; Yellow + ("white" 15 65535 65535 65535)) +"A list of VGA console colors, their indices and 16-bit RGB values.") + +(defun terminal-init-w32console () + "Terminal initialization function for w32 console." + ;; Share function key initialization with w32 gui frames + (x-setup-function-keys (selected-frame)) + (let* ((colors w32-tty-standard-colors) + (color (car colors))) + (tty-color-clear) + (while colors + (tty-color-define (car color) (cadr color) (cddr color)) + (setq colors (cdr colors) + color (car colors)))) + (clear-face-cache) + (tty-set-up-initial-frame-faces) + (run-hooks 'terminal-init-w32-hook)) + +;; arch-tag: 3195fd5e-ab86-4a46-b1dc-4f7a8c8deff3 diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index f39e2885cc9..2076d3cbbda 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -38,76 +38,84 @@ ;;; Code: +(defvar wyse50-terminal-map + (let ((map (make-sparse-keymap))) + (dolist (key-definition + '( ;; These might be set up by termcap and terminfo + ("\C-k" [up]) + ("\C-j" [down]) + ("\C-l" [right]) + ("\C-h" [left]) + ("\^a@\^m" [f1]) + ("\^aA\^m" [f2]) + ("\^aB\^m" [f3]) + ("\^aC\^m" [f4]) + ("\^aD\^m" [f5]) + ("\^aE\^m" [f6]) + ("\^aF\^m" [f7]) + ("\^aG\^m" [f8]) + ("\^aH\^m" [f9]) + + ;; These might be set up by terminfo + ("\eK" [next]) + ("\eT" [clearline]) + ("\^^" [home]) + ("\e\^^" [end]) + ("\eQ" [insert]) + ("\eE" [insertline]) + ("\eR" [deleteline]) + ("\eP" [print]) + ("\er" [replace]) + ("\^aI\^m" [f10]) + ("\^aJ\^m" [f11]) + ("\^aK\^m" [f12]) + ("\^aL\^m" [f13]) + ("\^aM\^m" [f14]) + ("\^aN\^m" [f15]) + ("\^aO\^m" [f16]) + ("\^a`\^m" [f17]) + ("\^aa\^m" [f18]) + ("\^ab\^m" [f19]) + ("\^ac\^m" [f20]) + ("\^ad\^m" [f21]) + ("\^ae\^m" [f22]) + ("\^af\^m" [f23]) + ("\^ag\^m" [f24]) + ("\^ah\^m" [f25]) + ("\^ai\^m" [f26]) + ("\^aj\^m" [f27]) + ("\^ak\^m" [f28]) + ("\^al\^m" [f29]) + ("\^am\^m" [f30]) + ("\^an\^m" [f31]) + ("\^ao\^m" [f32]) + + ;; Terminfo may know about these, but X won't + ("\eI" [key-stab]) ;; Not an X keysym + ("\eJ" [key-snext]) ;; Not an X keysym + ("\eY" [key-clear]) ;; Not an X keysym + + ;; These are totally strange :-) + ("\eW" [?\C-?]) ;; Not an X keysym + ("\^a\^k\^m" [funct-up]) ;; Not an X keysym + ("\^a\^j\^m" [funct-down]) ;; Not an X keysym + ("\^a\^l\^m" [funct-right]) ;; Not an X keysym + ("\^a\^h\^m" [funct-left]) ;; Not an X keysym + ("\^a\^m\^m" [funct-return]) ;; Not an X keysym + ("\^a\^i\^m" [funct-tab]) ;; Not an X keysym + )) + (define-key map + (car key-definition) (nth 1 key-definition))) + map)) + (defun terminal-init-wyse50 () "Terminal initialization function for wyse50." - (define-key function-key-map "\C-a" (make-keymap)) - (mapcar (function (lambda (key-definition) - (define-key function-key-map - (car key-definition) (nth 1 key-definition)))) - '( - ;; These might be set up by termcap and terminfo - ("\C-k" [up]) - ("\C-j" [down]) - ("\C-l" [right]) - ("\C-h" [left]) - ("\^a@\^m" [f1]) - ("\^aA\^m" [f2]) - ("\^aB\^m" [f3]) - ("\^aC\^m" [f4]) - ("\^aD\^m" [f5]) - ("\^aE\^m" [f6]) - ("\^aF\^m" [f7]) - ("\^aG\^m" [f8]) - ("\^aH\^m" [f9]) - - ;; These might be set up by terminfo - ("\eK" [next]) - ("\eT" [clearline]) - ("\^^" [home]) - ("\e\^^" [end]) - ("\eQ" [insert]) - ("\eE" [insertline]) - ("\eR" [deleteline]) - ("\eP" [print]) - ("\er" [replace]) - ("\^aI\^m" [f10]) - ("\^aJ\^m" [f11]) - ("\^aK\^m" [f12]) - ("\^aL\^m" [f13]) - ("\^aM\^m" [f14]) - ("\^aN\^m" [f15]) - ("\^aO\^m" [f16]) - ("\^a`\^m" [f17]) - ("\^aa\^m" [f18]) - ("\^ab\^m" [f19]) - ("\^ac\^m" [f20]) - ("\^ad\^m" [f21]) - ("\^ae\^m" [f22]) - ("\^af\^m" [f23]) - ("\^ag\^m" [f24]) - ("\^ah\^m" [f25]) - ("\^ai\^m" [f26]) - ("\^aj\^m" [f27]) - ("\^ak\^m" [f28]) - ("\^al\^m" [f29]) - ("\^am\^m" [f30]) - ("\^an\^m" [f31]) - ("\^ao\^m" [f32]) - - ;; Terminfo may know about these, but X won't - ("\eI" [key-stab]) ;; Not an X keysym - ("\eJ" [key-snext]) ;; Not an X keysym - ("\eY" [key-clear]) ;; Not an X keysym - - ;; These are totally strange :-) - ("\eW" [?\C-?]) ;; Not an X keysym - ("\^a\^k\^m" [funct-up]) ;; Not an X keysym - ("\^a\^j\^m" [funct-down]) ;; Not an X keysym - ("\^a\^l\^m" [funct-right]) ;; Not an X keysym - ("\^a\^h\^m" [funct-left]) ;; Not an X keysym - ("\^a\^m\^m" [funct-return]) ;; Not an X keysym - ("\^a\^i\^m" [funct-tab]) ;; Not an X keysym - )) + ;; Use inheritance to let the main keymap override these defaults. + ;; This way we don't override terminfo-derived settings or settings + ;; made in the .emacs file. + (let ((m (copy-keymap wyse50-terminal-map))) + (set-keymap-parent m (keymap-parent input-decode-map)) + (set-keymap-parent input-decode-map m)) ;; Miscellaneous hacks @@ -126,29 +134,29 @@ (concat "\ea23R" (1+ (frame-width)) "C\eG0")))))) (defun enable-arrow-keys () - "To be called by term-setup-hook. Overrides 6 Emacs standard keys + "To be called by `term-setup-hook'. Overrides 6 Emacs standard keys whose functions are then typed as follows: C-a Funct Left-arrow C-h M-? LFD Funct Return, some modes override down-arrow via LFD C-k CLR Line C-l Scrn CLR -M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar -" +M-r M-x move-to-window-line, Funct up-arrow or down-arrow are similar" (interactive) - (mapcar (function (lambda (key-definition) - (global-set-key (car key-definition) - (nth 1 key-definition)))) - ;; By unsetting C-a and then binding it to a prefix, we - ;; allow the rest of the function keys which start with C-a - ;; to be recognized. - '(("\C-a" nil) - ("\C-k" nil) - ("\C-j" nil) - ("\C-l" nil) - ("\C-h" nil) - ("\er" nil))) + ;; Not needed any more now that we use input-decode-map. + ;; (dolist (key-definition + ;; ;; By unsetting C-a and then binding it to a prefix, we + ;; ;; allow the rest of the function keys which start with C-a + ;; ;; to be recognized. + ;; '(("\C-a" nil) + ;; ("\C-k" nil) + ;; ("\C-j" nil) + ;; ("\C-l" nil) + ;; ("\C-h" nil) + ;; ("\er" nil))) + ;; (global-set-key (car key-definition) + ;; (nth 1 key-definition))) (fset 'enable-arrow-keys nil)) -;;; arch-tag: b6a05d37-eead-4cf6-b997-0f956c68881c +;; arch-tag: b6a05d37-eead-4cf6-b997-0f956c68881c ;;; wyse50.el ends here diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index c7f1aef803a..a0f7c1f3ca8 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -25,10 +25,16 @@ ;;; Commentary: -;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes -;; that X windows are to be used. Command line switches are parsed and those -;; pertaining to X are processed and removed from the command line. The -;; X display is opened and hooks are set for popping up the initial window. +;; X-win.el: this file defines functions to initialize the X window +;; system and process X-specific command line parameters before +;; creating the first X frame. + +;; Note that contrary to previous Emacs versions, the act of loading +;; this file should not have the side effect of initializing the +;; window system or processing command line arguments (this file is +;; now loaded in loadup.el). See the variables +;; `handle-args-function-alist' and +;; `window-system-initialization-alist' for more details. ;; startup.el will then examine startup files, and eventually call the hooks ;; which create the first window(s). @@ -65,7 +71,7 @@ ;; An alist of X options and the function which handles them. See ;; ../startup.el. -(if (not (eq window-system 'x)) +(if (not (fboundp 'x-create-frame)) (error "%s: Loading x-win.el but not compiled for X" (invocation-name))) (require 'frame) @@ -266,7 +272,7 @@ See also `emacs-session-save'.") If the directory ~/.emacs.d exists, we make a filename in there, otherwise a file in the home directory." (let ((basename (concat "session." session-id)) - (emacs-dir "~/.emacs.d/")) + (emacs-dir user-emacs-directory)) (expand-file-name (if (file-directory-p emacs-dir) (concat emacs-dir basename) (concat "~/.emacs-" basename))))) @@ -395,6 +401,7 @@ exists." (defconst x-pointer-ur-angle 148) (defconst x-pointer-watch 150) (defconst x-pointer-xterm 152) +(defconst x-pointer-invisible 255) ;; ;; Available colors @@ -1170,27 +1177,39 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") ;;;; Function keys -(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame - global-map) - -;; Map certain keypad keys into ASCII characters -;; that people usually expect. -(define-key function-key-map [backspace] [127]) -(define-key function-key-map [delete] [127]) -(define-key function-key-map [tab] [?\t]) -(define-key function-key-map [linefeed] [?\n]) -(define-key function-key-map [clear] [?\C-l]) -(define-key function-key-map [return] [?\C-m]) -(define-key function-key-map [escape] [?\e]) -(define-key function-key-map [M-backspace] [?\M-\d]) -(define-key function-key-map [M-delete] [?\M-\d]) -(define-key function-key-map [M-tab] [?\M-\t]) -(define-key function-key-map [M-linefeed] [?\M-\n]) -(define-key function-key-map [M-clear] [?\M-\C-l]) -(define-key function-key-map [M-return] [?\M-\C-m]) -(define-key function-key-map [M-escape] [?\M-\e]) -(define-key function-key-map [iso-lefttab] [backtab]) -(define-key function-key-map [S-iso-lefttab] [backtab]) +(defvar x-alternatives-map + (let ((map (make-sparse-keymap))) + ;; Map certain keypad keys into ASCII characters that people usually expect. + (define-key map [backspace] [127]) + (define-key map [delete] [127]) + (define-key map [tab] [?\t]) + (define-key map [linefeed] [?\n]) + (define-key map [clear] [?\C-l]) + (define-key map [return] [?\C-m]) + (define-key map [escape] [?\e]) + (define-key map [M-backspace] [?\M-\d]) + (define-key map [M-delete] [?\M-\d]) + (define-key map [M-tab] [?\M-\t]) + (define-key map [M-linefeed] [?\M-\n]) + (define-key map [M-clear] [?\M-\C-l]) + (define-key map [M-return] [?\M-\C-m]) + (define-key map [M-escape] [?\M-\e]) + (define-key map [iso-lefttab] [backtab]) + (define-key map [S-iso-lefttab] [backtab]) + map) + "Keymap of possible alternative meanings for some keys.") + +(defun x-setup-function-keys (frame) + "Set up `function-key-map' on FRAME for the X window system." + ;; Don't do this twice on the same display, or it would break + ;; normal-erase-is-backspace-mode. + (unless (terminal-parameter frame 'x-setup-function-keys) + ;; Map certain keypad keys into ASCII characters that people usually expect. + (with-selected-frame frame + (let ((map (copy-keymap x-alternatives-map))) + (set-keymap-parent map (keymap-parent local-function-key-map)) + (set-keymap-parent local-function-key-map map))) + (set-terminal-parameter frame 'x-setup-function-keys t))) ;; These tell read-char how to convert ;; these special chars to ASCII. @@ -1209,30 +1228,7 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") "Return the appropriate value of `system-key-alist' for VENDOR. VENDOR is a string containing the name of the X Server's vendor, as returned by `x-server-vendor'." - ;; Fixme: Drop Apollo now? - (cond ((string-equal vendor "Apollo Computer Inc.") - '((65280 . linedel) - (65281 . chardel) - (65282 . copy) - (65283 . cut) - (65284 . paste) - (65285 . move) - (65286 . grow) - (65287 . cmd) - (65288 . shell) - (65289 . leftbar) - (65290 . rightbar) - (65291 . leftbox) - (65292 . rightbox) - (65293 . upbox) - (65294 . downbox) - (65295 . pop) - (65296 . read) - (65297 . edit) - (65298 . save) - (65299 . exit) - (65300 . repeat))) - ((or (string-equal vendor "Hewlett-Packard Incorporated") + (cond ((or (string-equal vendor "Hewlett-Packard Incorporated") (string-equal vendor "Hewlett-Packard Company")) '(( 168 . mute-acute) ( 169 . mute-grave) @@ -2154,31 +2150,38 @@ This is in addition to, but in preference to, the primary selection." :type 'boolean :group 'killing) +(defcustom x-select-enable-primary t + "Non-nil means cutting and pasting uses the primary selection." + :type 'boolean + :group 'killing) + (defun x-select-text (text &optional push) "Make TEXT, a string, the primary X selection. Also, set the value of X cut buffer 0, for backward compatibility with older X applications. gildea@stop.mail-abuse.org says it's not desirable to put kills in the clipboard." - ;; Don't send the cut buffer too much text. - ;; It becomes slow, and if really big it causes errors. - (cond ((>= (length text) x-cut-buffer-max) - (x-set-cut-buffer "" push) - (setq x-last-selected-text-cut "" - x-last-selected-text-cut-encoded "")) - (t - (setq x-last-selected-text-cut text - x-last-cut-buffer-coding 'iso-latin-1 - x-last-selected-text-cut-encoded - ;; ICCCM says cut buffer always contain ISO-Latin-1 - (encode-coding-string text 'iso-latin-1)) - (x-set-cut-buffer x-last-selected-text-cut-encoded push))) - (x-set-selection 'PRIMARY text) - (setq x-last-selected-text-primary text) - (when x-select-enable-clipboard - (x-set-selection 'CLIPBOARD text) - (setq x-last-selected-text-clipboard text)) - ) + ;; With multi-tty, this function may be called from a tty frame. + (when (eq (framep (selected-frame)) 'x) + ;; Don't send the cut buffer too much text. + ;; It becomes slow, and if really big it causes errors. + (cond ((>= (length text) x-cut-buffer-max) + (x-set-cut-buffer "" push) + (setq x-last-selected-text-cut "" + x-last-selected-text-cut-encoded "")) + (t + (setq x-last-selected-text-cut text + x-last-cut-buffer-coding 'iso-latin-1 + x-last-selected-text-cut-encoded + ;; ICCCM says cut buffer always contain ISO-Latin-1 + (encode-coding-string text 'iso-latin-1)) + (x-set-cut-buffer x-last-selected-text-cut-encoded push))) + (when x-select-enable-primary + (x-set-selection 'PRIMARY text) + (setq x-last-selected-text-primary text)) + (when x-select-enable-clipboard + (x-set-selection 'CLIPBOARD text) + (setq x-last-selected-text-clipboard text)))) (defvar x-select-request-type nil "*Data type request for X selection. @@ -2299,263 +2302,267 @@ order until succeed.") ;; it returns nil the second time. This is so that a single ;; selection won't be added to the kill ring over and over. (defun x-cut-buffer-or-selection-value () - (let (clip-text primary-text cut-text) - (when x-select-enable-clipboard - (setq clip-text (x-selection-value 'CLIPBOARD)) - (if (string= clip-text "") (setq clip-text nil)) - - ;; Check the CLIPBOARD selection for 'newness', is it different + ;; With multi-tty, this function may be called from a tty frame. + (when (eq (framep (selected-frame)) 'x) + (let (clip-text primary-text cut-text) + (when x-select-enable-clipboard + (setq clip-text (x-selection-value 'CLIPBOARD)) + (if (string= clip-text "") (setq clip-text nil)) + + ;; Check the CLIPBOARD selection for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq clip-text + (cond ;; check clipboard + ((or (not clip-text) (string= clip-text "")) + (setq x-last-selected-text-clipboard nil)) + ((eq clip-text x-last-selected-text-clipboard) nil) + ((string= clip-text x-last-selected-text-clipboard) + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + (setq x-last-selected-text-clipboard clip-text) + nil) + (t (setq x-last-selected-text-clipboard clip-text))))) + + (when x-select-enable-primary + (setq primary-text (x-selection-value 'PRIMARY)) + ;; Check the PRIMARY selection for 'newness', is it different + ;; from what we remebered them to be last time we did a + ;; cut/paste operation. + (setq primary-text + (cond ;; check primary selection + ((or (not primary-text) (string= primary-text "")) + (setq x-last-selected-text-primary nil)) + ((eq primary-text x-last-selected-text-primary) nil) + ((string= primary-text x-last-selected-text-primary) + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + (setq x-last-selected-text-primary primary-text) + nil) + (t + (setq x-last-selected-text-primary primary-text))))) + + (setq cut-text (x-get-cut-buffer 0)) + + ;; Check the x cut buffer for 'newness', is it different ;; from what we remebered them to be last time we did a ;; cut/paste operation. - (setq clip-text - (cond;; check clipboard - ((or (not clip-text) (string= clip-text "")) - (setq x-last-selected-text-clipboard nil)) - ((eq clip-text x-last-selected-text-clipboard) nil) - ((string= clip-text x-last-selected-text-clipboard) - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - (setq x-last-selected-text-clipboard clip-text) - nil) - (t - (setq x-last-selected-text-clipboard clip-text)))) - ) - - (setq primary-text (x-selection-value 'PRIMARY)) - ;; Check the PRIMARY selection for 'newness', is it different - ;; from what we remebered them to be last time we did a - ;; cut/paste operation. - (setq primary-text - (cond;; check primary selection - ((or (not primary-text) (string= primary-text "")) - (setq x-last-selected-text-primary nil)) - ((eq primary-text x-last-selected-text-primary) nil) - ((string= primary-text x-last-selected-text-primary) - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - (setq x-last-selected-text-primary primary-text) - nil) - (t - (setq x-last-selected-text-primary primary-text)))) - - (setq cut-text (x-get-cut-buffer 0)) - - ;; Check the x cut buffer for 'newness', is it different - ;; from what we remebered them to be last time we did a - ;; cut/paste operation. - (setq cut-text - (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) - (cond;; check cut buffer - ((or (not cut-text) (string= cut-text "")) - (setq x-last-selected-text-cut nil)) - ;; This short cut doesn't work because x-get-cut-buffer - ;; always returns a newly created string. - ;; ((eq cut-text x-last-selected-text-cut) nil) - ((and (string= cut-text x-last-selected-text-cut-encoded) - (eq x-last-cut-buffer-coding next-coding)) - ;; See the comment above. No need of this recording. - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - ;; (setq x-last-selected-text-cut cut-text) - nil) - (t - (setq x-last-selected-text-cut-encoded cut-text - x-last-cut-buffer-coding next-coding - x-last-selected-text-cut - ;; ICCCM says cut buffer always contain ISO-Latin-1, but - ;; use next-selection-coding-system if not nil. - (decode-coding-string - cut-text next-coding)))))) - - ;; As we have done one selection, clear this now. - (setq next-selection-coding-system nil) - - ;; At this point we have recorded the current values for the - ;; selection from clipboard (if we are supposed to) primary, - ;; and cut buffer. So return the first one that has changed - ;; (which is the first non-null one). - ;; - ;; NOTE: There will be cases where more than one of these has - ;; changed and the new values differ. This indicates that - ;; something like the following has happened since the last time - ;; we looked at the selections: Application X set all the - ;; selections, then Application Y set only one or two of them (say - ;; just the cut-buffer). In this case since we don't have - ;; timestamps there is no way to know what the 'correct' value to - ;; return is. The nice thing to do would be to tell the user we - ;; saw multiple possible selections and ask the user which was the - ;; one they wanted. - ;; This code is still a big improvement because now the user can - ;; futz with the current selection and get emacs to pay attention - ;; to the cut buffer again (previously as soon as clipboard or - ;; primary had been set the cut buffer would essentially never be - ;; checked again). - (or clip-text primary-text cut-text) - )) + (setq cut-text + (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) + (cond ;; check cut buffer + ((or (not cut-text) (string= cut-text "")) + (setq x-last-selected-text-cut nil)) + ;; This short cut doesn't work because x-get-cut-buffer + ;; always returns a newly created string. + ;; ((eq cut-text x-last-selected-text-cut) nil) + ((and (string= cut-text x-last-selected-text-cut-encoded) + (eq x-last-cut-buffer-coding next-coding)) + ;; See the comment above. No need of this recording. + ;; Record the newer string, + ;; so subsequent calls can use the `eq' test. + ;; (setq x-last-selected-text-cut cut-text) + nil) + (t + (setq x-last-selected-text-cut-encoded cut-text + x-last-cut-buffer-coding next-coding + x-last-selected-text-cut + ;; ICCCM says cut buffer always contain ISO-Latin-1, but + ;; use next-selection-coding-system if not nil. + (decode-coding-string + cut-text next-coding)))))) + + ;; As we have done one selection, clear this now. + (setq next-selection-coding-system nil) + + ;; At this point we have recorded the current values for the + ;; selection from clipboard (if we are supposed to) primary, + ;; and cut buffer. So return the first one that has changed + ;; (which is the first non-null one). + ;; + ;; NOTE: There will be cases where more than one of these has + ;; changed and the new values differ. This indicates that + ;; something like the following has happened since the last time + ;; we looked at the selections: Application X set all the + ;; selections, then Application Y set only one or two of them (say + ;; just the cut-buffer). In this case since we don't have + ;; timestamps there is no way to know what the 'correct' value to + ;; return is. The nice thing to do would be to tell the user we + ;; saw multiple possible selections and ask the user which was the + ;; one they wanted. + ;; This code is still a big improvement because now the user can + ;; futz with the current selection and get emacs to pay attention + ;; to the cut buffer again (previously as soon as clipboard or + ;; primary had been set the cut buffer would essentially never be + ;; checked again). + (or clip-text primary-text cut-text) + ))) - -;; Do the actual X Windows setup here; the above code just defines -;; functions and variables that we use now. - -(setq command-line-args (x-handle-args command-line-args)) - -;; Make sure we have a valid resource name. -(or (stringp x-resource-name) - (let (i) - (setq x-resource-name (invocation-name)) - - ;; Change any . or * characters in x-resource-name to hyphens, - ;; so as not to choke when we use it in X resource queries. - (while (setq i (string-match "[.*]" x-resource-name)) - (aset x-resource-name i ?-)))) - -(x-open-connection (or x-display-name - (setq x-display-name (getenv "DISPLAY"))) - x-command-line-resources - ;; Exit Emacs with fatal error if this fails. - t) - -(setq frame-creation-function 'x-create-frame-with-faces) - -(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - -;; Setup the default fontset. -(setup-default-fontset) - -;; Create the standard fontset. -(create-fontset-from-fontset-spec standard-fontset-spec t) - -;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). -(create-fontset-from-x-resource) - -;; Try to create a fontset from a font specification which comes -;; from initial-frame-alist, default-frame-alist, or X resource. -;; A font specification in command line argument (i.e. -fn XXXX) -;; should be already in default-frame-alist as a `font' -;; parameter. However, any font specifications in site-start -;; library, user's init file (.emacs), and default.el are not -;; yet handled here. - -(let ((font (or (cdr (assq 'font initial-frame-alist)) - (cdr (assq 'font default-frame-alist)) - (x-get-resource "font" "Font"))) - xlfd-fields resolved-name) - (if (and font - (not (query-fontset font)) - (setq resolved-name (x-resolve-font-name font)) - (setq xlfd-fields (x-decompose-font-name font))) - (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) - (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) - ;; Create a fontset from FONT. The fontset name is - ;; generated from FONT. - (create-fontset-from-ascii-font font resolved-name "startup")))) - -;; Apply a geometry resource to the initial frame. Put it at the end -;; of the alist, so that anything specified on the command line takes -;; precedence. -(let* ((res-geometry (x-get-resource "geometry" "Geometry")) - parsed) - (if res-geometry - (progn - (setq parsed (x-parse-geometry res-geometry)) - ;; If the resource specifies a position, - ;; call the position and size "user-specified". - (if (or (assq 'top parsed) (assq 'left parsed)) - (setq parsed (cons '(user-position . t) - (cons '(user-size . t) parsed)))) - ;; All geometry parms apply to the initial frame. - (setq initial-frame-alist (append initial-frame-alist parsed)) - ;; The size parms apply to all frames. Don't set it if there are - ;; sizes there already (from command line). - (if (and (assq 'height parsed) - (not (assq 'height default-frame-alist))) - (setq default-frame-alist - (cons (cons 'height (cdr (assq 'height parsed))) - default-frame-alist))) - (if (and (assq 'width parsed) - (not (assq 'width default-frame-alist))) - (setq default-frame-alist - (cons (cons 'width (cdr (assq 'width parsed))) - default-frame-alist)))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv - (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (setq default-frame-alist - (cons '(reverse . t) default-frame-alist))))) +;; Arrange for the kill and yank functions to set and check the clipboard. +(setq interprogram-cut-function 'x-select-text) +(setq interprogram-paste-function 'x-cut-buffer-or-selection-value) -;; Set x-selection-timeout, measured in milliseconds. -(let ((res-selection-timeout - (x-get-resource "selectionTimeout" "SelectionTimeout"))) - (setq x-selection-timeout 20000) - (if res-selection-timeout - (setq x-selection-timeout (string-to-number res-selection-timeout)))) +(defun x-clipboard-yank () + "Insert the clipboard contents, or the last stretch of killed text." + (interactive "*") + (let ((clipboard-text (x-selection-value 'CLIPBOARD)) + (x-select-enable-clipboard t)) + (if (and clipboard-text (> (length clipboard-text) 0)) + (kill-new clipboard-text)) + (yank))) -;; Set scroll bar mode to right if set by X resources. Default is left. -(if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right") - (customize-set-variable 'scroll-bar-mode 'right)) +(defun x-menu-bar-open (&optional frame) + "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'." + (interactive "i") + (if menu-bar-mode (accelerate-menu frame) + (tmm-menubar))) + + +;;; Window system initialization. (defun x-win-suspend-error () (error "Suspending an Emacs running under X makes no sense")) -(add-hook 'suspend-hook 'x-win-suspend-error) -;; Arrange for the kill and yank functions to set and check the clipboard. -(setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-cut-buffer-or-selection-value) +(defvar x-initialized nil + "Non-nil if the X window system has been initialized.") + +(defun x-initialize-window-system () + "Initialize Emacs for X frames and open the first connection to an X server." + ;; Make sure we have a valid resource name. + (or (stringp x-resource-name) + (let (i) + (setq x-resource-name (invocation-name)) + + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (while (setq i (string-match "[.*]" x-resource-name)) + (aset x-resource-name i ?-)))) + + (x-open-connection (or x-display-name + (setq x-display-name (or (getenv "DISPLAY" (selected-frame)) + (getenv "DISPLAY")))) + x-command-line-resources + ;; Exit Emacs with fatal error if this fails and we + ;; are the initial display. + (eq initial-window-system 'x)) + + (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) + x-cut-buffer-max)) + + ;; Setup the default fontset. + (setup-default-fontset) + + ;; Create the standard fontset. + (create-fontset-from-fontset-spec standard-fontset-spec t) + + ;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...). + (create-fontset-from-x-resource) + + ;; Try to create a fontset from a font specification which comes + ;; from initial-frame-alist, default-frame-alist, or X resource. + ;; A font specification in command line argument (i.e. -fn XXXX) + ;; should be already in default-frame-alist as a `font' + ;; parameter. However, any font specifications in site-start + ;; library, user's init file (.emacs), and default.el are not + ;; yet handled here. + + (let ((font (or (cdr (assq 'font initial-frame-alist)) + (cdr (assq 'font default-frame-alist)) + (x-get-resource "font" "Font"))) + xlfd-fields resolved-name) + (if (and font + (not (query-fontset font)) + (setq resolved-name (x-resolve-font-name font)) + (setq xlfd-fields (x-decompose-font-name font))) + (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum)) + (new-fontset font (x-complement-fontset-spec xlfd-fields nil)) + ;; Create a fontset from FONT. The fontset name is + ;; generated from FONT. + (create-fontset-from-ascii-font font resolved-name "startup")))) + + ;; Set scroll bar mode to right if set by X resources. Default is left. + (if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right") + (customize-set-variable 'scroll-bar-mode 'right)) + + ;; Apply a geometry resource to the initial frame. Put it at the end + ;; of the alist, so that anything specified on the command line takes + ;; precedence. + (let* ((res-geometry (x-get-resource "geometry" "Geometry")) + parsed) + (if res-geometry + (progn + (setq parsed (x-parse-geometry res-geometry)) + ;; If the resource specifies a position, + ;; call the position and size "user-specified". + (if (or (assq 'top parsed) (assq 'left parsed)) + (setq parsed (cons '(user-position . t) + (cons '(user-size . t) parsed)))) + ;; All geometry parms apply to the initial frame. + (setq initial-frame-alist (append initial-frame-alist parsed)) + ;; The size parms apply to all frames. Don't set it if there are + ;; sizes there already (from command line). + (if (and (assq 'height parsed) + (not (assq 'height default-frame-alist))) + (setq default-frame-alist + (cons (cons 'height (cdr (assq 'height parsed))) + default-frame-alist))) + (if (and (assq 'width parsed) + (not (assq 'width default-frame-alist))) + (setq default-frame-alist + (cons (cons 'width (cdr (assq 'width parsed))) + default-frame-alist)))))) + + ;; Check the reverseVideo resource. + (let ((case-fold-search t)) + (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) + (if (and rv + (string-match "^\\(true\\|yes\\|on\\)$" rv)) + (setq default-frame-alist + (cons '(reverse . t) default-frame-alist))))) -;; Turn off window-splitting optimization; X is usually fast enough -;; that this is only annoying. -(setq split-window-keep-point t) + ;; Set x-selection-timeout, measured in milliseconds. + (let ((res-selection-timeout + (x-get-resource "selectionTimeout" "SelectionTimeout"))) + (setq x-selection-timeout 20000) + (if res-selection-timeout + (setq x-selection-timeout (string-to-number res-selection-timeout)))) -;; Don't show the frame name; that's redundant with X. -(setq-default mode-line-frame-identification " ") + ;; Don't let Emacs suspend under X. + (add-hook 'suspend-hook 'x-win-suspend-error) -;; Motif direct handling of f10 wasn't working right, -;; So temporarily we've turned it off in lwlib-Xm.c -;; and turned the Emacs f10 back on. -;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. -;; (if (featurep 'motif) -;; (global-set-key [f10] 'ignore)) + ;; Turn off window-splitting optimization; X is usually fast enough + ;; that this is only annoying. + (setq split-window-keep-point t) -;; Turn on support for mouse wheels. -(mouse-wheel-mode 1) + ;; Motif direct handling of f10 wasn't working right, + ;; So temporarily we've turned it off in lwlib-Xm.c + ;; and turned the Emacs f10 back on. + ;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. + ;; (if (featurep 'motif) + ;; (global-set-key [f10] 'ignore)) + ;; Turn on support for mouse wheels. + (mouse-wheel-mode 1) -;; Enable CLIPBOARD copy/paste through menu bar commands. -(menu-bar-enable-clipboard) + ;; Enable CLIPBOARD copy/paste through menu bar commands. + (menu-bar-enable-clipboard) -;; Override Paste so it looks at CLIPBOARD first. -(defun x-clipboard-yank () - "Insert the clipboard contents, or the last stretch of killed text." - (interactive "*") - (let ((clipboard-text (x-selection-value 'CLIPBOARD)) - (x-select-enable-clipboard t)) - (if (and clipboard-text (> (length clipboard-text) 0)) - (kill-new clipboard-text)) - (yank))) + ;; Override Paste so it looks at CLIPBOARD first. + (define-key menu-bar-edit-menu [paste] + (append '(menu-item "Paste" x-clipboard-yank + :enable (not buffer-read-only) + :help "Paste (yank) text most recently cut/copied") + nil)) + + (setq x-initialized t)) -(define-key menu-bar-edit-menu [paste] - '(menu-item "Paste" x-clipboard-yank - :enable (not buffer-read-only) - :help "Paste (yank) text most recently cut/copied")) +(add-to-list 'handle-args-function-alist '(x . x-handle-args)) +(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces)) +(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system)) ;; Initiate drag and drop (add-hook 'after-make-frame-functions 'x-dnd-init-frame) (define-key special-event-map [drag-n-drop] 'x-dnd-handle-drag-n-drop-event) -;; Let F10 do menu bar navigation. -(defun x-menu-bar-open (&optional frame) - "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'." - (interactive "i") - (if menu-bar-mode (menu-bar-open frame) - (tmm-menubar))) - -(and (fboundp 'menu-bar-open) - (global-set-key [f10] 'x-menu-bar-open)) - (defcustom x-gtk-stock-map '( ("etc/images/new" . "gtk-new") @@ -2578,16 +2585,53 @@ order until succeed.") ("etc/images/jump-to" . "gtk-jump-to") ("etc/images/index" . "gtk-index") ("etc/images/search" . "gtk-find") - ("etc/images/exit" . "gtk-quit")) + ("etc/images/exit" . "gtk-quit") + ;; Used in Gnus and/or MH-E: + ("etc/images/attach.xpm" . "gtk-attach") + ("etc/images/connect.xpm" . "gtk-connect") + ("etc/images/contact.xpm" . "gtk-contact") + ("etc/images/delete.xpm" . "gtk-delete") + ("etc/images/describe.xpm" . "gtk-properties") + ("etc/images/disconnect.xpm" . "gtk-disconnect") + ;; ("etc/images/exit.xpm" . "gtk-exit") + ("etc/images/lock-broken.xpm" . "gtk-lock_broken") + ("etc/images/lock-ok.xpm" . "gtk-lock_ok") + ("etc/images/lock.xpm" . "gtk-lock") + ("etc/images/next-page.xpm" . "gtk-next-page") + ("etc/images/refresh.xpm" . "gtk-refresh") + ("etc/images/sort-ascending.xpm" . "gtk-sort-ascending") + ("etc/images/sort-column-ascending.xpm" . "gtk-sort-column-ascending") + ("etc/images/sort-criteria.xpm" . "gtk-sort-criteria") + ("etc/images/sort-descending.xpm" . "gtk-sort-descending") + ("etc/images/sort-row-ascending.xpm" . "gtk-sort-row-ascending") + ("images/gnus/toggle-subscription.xpm" . "gtk-task-recurring") + ("images/mail/compose.xpm" . "gtk-mail-compose") + ("images/mail/copy.xpm" . "gtk-mail-copy") + ("images/mail/forward.xpm" . "gtk-mail-forward") + ("images/mail/inbox.xpm" . "gtk-inbox") + ("images/mail/move.xpm" . "gtk-mail-move") + ("images/mail/not-spam.xpm" . "gtk-not-spam") + ("images/mail/outbox.xpm" . "gtk-outbox") + ("images/mail/reply-all.xpm" . "gtk-mail-reply-to-all") + ("images/mail/reply.xpm" . "gtk-mail-reply") + ("images/mail/save-draft.xpm" . "gtk-mail-handling") + ("images/mail/send.xpm" . "gtk-mail-send") + ("images/mail/spam.xpm" . "gtk-spam") + ;; No themed versions available: + ;; mail/preview.xpm (combining stock_mail and stock_zoom) + ;; mail/save.xpm (combining stock_mail, stock_save and stock_convert) + ) "How icons for tool bars are mapped to Gtk+ stock items. Emacs must be compiled with the Gtk+ toolkit for this to have any effect. A value that begins with n: denotes a named icon instead of a stock icon." :version "22.2" - :type 'alist + :type '(choice (repeat (choice symbol + (cons (string :tag "Emacs icon") + (string :tag "Stock/named"))))) :group 'x) -(defvar icon-map-list nil - "*A list of alists that maps icon file names to stock/named icons. +(defcustom icon-map-list '(x-gtk-stock-map) + "A list of alists that maps icon file names to stock/named icons. The alists are searched in the order they appear. The first match is used. The keys in the alists are file names without extension and with two directory components. For example, to map /usr/share/emacs/22.1.1/etc/images/open.xpm @@ -2599,7 +2643,16 @@ Themes also have named icons. To map to one of those, use n: before the name: (\"etc/images/diropen\" . \"n:system-file-manager\") -The list elements are either the symbol name for the alist or the alist itself.") +The list elements are either the symbol name for the alist or the +alist itself. + +If you don't want stock icons, set the variable to nil." + :version "22.2" + :type '(choice (const :tag "Don't use stock icons" nil) + (repeat (choice symbol + (cons (string :tag "Emacs icon") + (string :tag "Stock/named"))))) + :group 'x) (defun x-gtk-map-stock (file) "Map icon with file name FILE to a Gtk+ stock name, using `x-gtk-stock-map'." @@ -2616,5 +2669,7 @@ The list elements are either the symbol name for the alist or the alist itself." (and value (cdr value))) nil)) +(provide 'x-win) + ;; arch-tag: f1501302-db8b-4d95-88e3-116697d89f78 ;;; x-win.el ends here diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 77d1fe32885..2fd8d47afac 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -27,429 +27,487 @@ ;;; Code: +(defvar xterm-function-map + (let ((map (make-sparse-keymap))) + + ;; 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[23~" [f11]) + (define-key map "\e[24~" [f12]) + + (define-key map "\eO2P" [S-f1]) + (define-key map "\eO2Q" [S-f2]) + (define-key map "\eO2R" [S-f3]) + (define-key map "\eO2S" [S-f4]) + (define-key map "\e[1;2P" [S-f1]) + (define-key map "\e[1;2Q" [S-f2]) + (define-key map "\e[1;2R" [S-f3]) + (define-key map "\e[1;2S" [S-f4]) + (define-key map "\e[15;2~" [S-f5]) + (define-key map "\e[17;2~" [S-f6]) + (define-key map "\e[18;2~" [S-f7]) + (define-key map "\e[19;2~" [S-f8]) + (define-key map "\e[20;2~" [S-f9]) + (define-key map "\e[21;2~" [S-f10]) + (define-key map "\e[23;2~" [S-f11]) + (define-key map "\e[24;2~" [S-f12]) + + (define-key map "\eO5P" [C-f1]) + (define-key map "\eO5Q" [C-f2]) + (define-key map "\eO5R" [C-f3]) + (define-key map "\eO5S" [C-f4]) + (define-key map "\e[15;5~" [C-f5]) + (define-key map "\e[17;5~" [C-f6]) + (define-key map "\e[18;5~" [C-f7]) + (define-key map "\e[19;5~" [C-f8]) + (define-key map "\e[20;5~" [C-f9]) + (define-key map "\e[21;5~" [C-f10]) + (define-key map "\e[23;5~" [C-f11]) + (define-key map "\e[24;5~" [C-f12]) + + (define-key map "\eO6P" [C-S-f1]) + (define-key map "\eO6Q" [C-S-f2]) + (define-key map "\eO6R" [C-S-f3]) + (define-key map "\eO6S" [C-S-f4]) + (define-key map "\e[15;6~" [C-S-f5]) + (define-key map "\e[17;6~" [C-S-f6]) + (define-key map "\e[18;6~" [C-S-f7]) + (define-key map "\e[19;6~" [C-S-f8]) + (define-key map "\e[20;6~" [C-S-f9]) + (define-key map "\e[21;6~" [C-S-f10]) + (define-key map "\e[23;6~" [C-S-f11]) + (define-key map "\e[24;6~" [C-S-f12]) + + (define-key map "\eO3P" [M-f1]) + (define-key map "\eO3Q" [M-f2]) + (define-key map "\eO3R" [M-f3]) + (define-key map "\eO3S" [M-f4]) + (define-key map "\e[15;3~" [M-f5]) + (define-key map "\e[17;3~" [M-f6]) + (define-key map "\e[18;3~" [M-f7]) + (define-key map "\e[19;3~" [M-f8]) + (define-key map "\e[20;3~" [M-f9]) + (define-key map "\e[21;3~" [M-f10]) + (define-key map "\e[23;3~" [M-f11]) + (define-key map "\e[24;3~" [M-f12]) + + (define-key map "\eO4P" [M-S-f1]) + (define-key map "\eO4Q" [M-S-f2]) + (define-key map "\eO4R" [M-S-f3]) + (define-key map "\eO4S" [M-S-f4]) + (define-key map "\e[15;4~" [M-S-f5]) + (define-key map "\e[17;4~" [M-S-f6]) + (define-key map "\e[18;4~" [M-S-f7]) + (define-key map "\e[19;4~" [M-S-f8]) + (define-key map "\e[20;4~" [M-S-f9]) + (define-key map "\e[21;4~" [M-S-f10]) + (define-key map "\e[23;4~" [M-S-f11]) + (define-key map "\e[24;4~" [M-S-f12]) + + (define-key map "\eOA" [up]) + (define-key map "\eOB" [down]) + (define-key map "\eOC" [right]) + (define-key map "\eOD" [left]) + (define-key map "\eOF" [end]) + (define-key map "\eOH" [home]) + + (define-key map "\e[1;2A" [S-up]) + (define-key map "\e[1;2B" [S-down]) + (define-key map "\e[1;2C" [S-right]) + (define-key map "\e[1;2D" [S-left]) + (define-key map "\e[1;2F" [S-end]) + (define-key map "\e[1;2H" [S-home]) + + (define-key map "\e[1;4A" [M-S-up]) + (define-key map "\e[1;4B" [M-S-down]) + (define-key map "\e[1;4C" [M-S-right]) + (define-key map "\e[1;4D" [M-S-left]) + (define-key map "\e[1;4F" [M-S-end]) + (define-key map "\e[1;4H" [M-S-home]) + + (define-key map "\e[1;5A" [C-up]) + (define-key map "\e[1;5B" [C-down]) + (define-key map "\e[1;5C" [C-right]) + (define-key map "\e[1;5D" [C-left]) + (define-key map "\e[1;5F" [C-end]) + (define-key map "\e[1;5H" [C-home]) + + (define-key map "\e[1;6A" [C-S-up]) + (define-key map "\e[1;6B" [C-S-down]) + (define-key map "\e[1;6C" [C-S-right]) + (define-key map "\e[1;6D" [C-S-left]) + (define-key map "\e[1;6F" [C-S-end]) + (define-key map "\e[1;6H" [C-S-home]) + + (define-key map "\e[1;7A" [C-M-up]) + (define-key map "\e[1;7B" [C-M-down]) + (define-key map "\e[1;7C" [C-M-right]) + (define-key map "\e[1;7D" [C-M-left]) + (define-key map "\e[1;7F" [C-M-end]) + (define-key map "\e[1;7H" [C-M-home]) + + (define-key map "\e[1;8A" [C-M-S-up]) + (define-key map "\e[1;8B" [C-M-S-down]) + (define-key map "\e[1;8C" [C-M-S-right]) + (define-key map "\e[1;8D" [C-M-S-left]) + (define-key map "\e[1;8F" [C-M-S-end]) + (define-key map "\e[1;8H" [C-M-S-home]) + + (define-key map "\e[1;3A" [M-up]) + (define-key map "\e[1;3B" [M-down]) + (define-key map "\e[1;3C" [M-right]) + (define-key map "\e[1;3D" [M-left]) + (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]) + + (define-key map "\e[2;4~" [M-S-insert]) + (define-key map "\e[3;4~" [M-S-delete]) + (define-key map "\e[5;4~" [M-S-prior]) + (define-key map "\e[6;4~" [M-S-next]) + + (define-key map "\e[2;5~" [C-insert]) + (define-key map "\e[3;5~" [C-delete]) + (define-key map "\e[5;5~" [C-prior]) + (define-key map "\e[6;5~" [C-next]) + + (define-key map "\e[2;6~" [C-S-insert]) + (define-key map "\e[3;6~" [C-S-delete]) + (define-key map "\e[5;6~" [C-S-prior]) + (define-key map "\e[6;6~" [C-S-next]) + + (define-key map "\e[2;7~" [C-M-insert]) + (define-key map "\e[3;7~" [C-M-delete]) + (define-key map "\e[5;7~" [C-M-prior]) + (define-key map "\e[6;7~" [C-M-next]) + + (define-key map "\e[2;8~" [C-M-S-insert]) + (define-key map "\e[3;8~" [C-M-S-delete]) + (define-key map "\e[5;8~" [C-M-S-prior]) + (define-key map "\e[6;8~" [C-M-S-next]) + + (define-key map "\e[2;3~" [M-insert]) + (define-key map "\e[3;3~" [M-delete]) + (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]) + (define-key map "\eOk" [kp-add]) + (define-key map "\eOl" [kp-separator]) + (define-key map "\eOm" [kp-subtract]) + (define-key map "\eOo" [kp-divide]) + (define-key map "\eOp" [kp-0]) + (define-key map "\eOq" [kp-1]) + (define-key map "\eOr" [kp-2]) + (define-key map "\eOs" [kp-3]) + (define-key map "\eOt" [kp-4]) + (define-key map "\eOu" [kp-5]) + (define-key map "\eOv" [kp-6]) + (define-key map "\eOw" [kp-7]) + (define-key map "\eOx" [kp-8]) + (define-key map "\eOy" [kp-9]) + + ;; These keys are available in xterm starting from version 216 + ;; if the modifyOtherKeys resource is set to 1. + + (define-key map "\e[27;5;9~" [C-tab]) + (define-key map "\e[27;5;13~" [C-return]) + (define-key map "\e[27;5;39~" [?\C-\']) + (define-key map "\e[27;5;44~" [?\C-,]) + (define-key map "\e[27;5;45~" [?\C--]) + (define-key map "\e[27;5;46~" [?\C-.]) + (define-key map "\e[27;5;47~" [?\C-/]) + (define-key map "\e[27;5;48~" [?\C-0]) + (define-key map "\e[27;5;49~" [?\C-1]) + ;; Not all C-DIGIT keys have a distinct binding. + (define-key map "\e[27;5;57~" [?\C-9]) + (define-key map "\e[27;5;59~" [?\C-\;]) + (define-key map "\e[27;5;61~" [?\C-=]) + (define-key map "\e[27;5;92~" [?\C-\\]) + + (define-key map "\e[27;6;33~" [?\C-!]) + (define-key map "\e[27;6;34~" [?\C-\"]) + (define-key map "\e[27;6;35~" [?\C-#]) + (define-key map "\e[27;6;36~" [?\C-$]) + (define-key map "\e[27;6;37~" [?\C-%]) + (define-key map "\e[27;6;38~" [?\C-&]) + (define-key map "\e[27;6;40~" [?\C-(]) + (define-key map "\e[27;6;41~" [?\C-)]) + (define-key map "\e[27;6;42~" [?\C-*]) + (define-key map "\e[27;6;43~" [?\C-+]) + (define-key map "\e[27;6;58~" [?\C-:]) + (define-key map "\e[27;6;60~" [?\C-<]) + (define-key map "\e[27;6;62~" [?\C->]) + (define-key map "\e[27;6;63~" [(control ??)]) + + ;; These are the strings emitted for various C-M- combinations + ;; for keyboards that the Meta and Alt modifiers are on the same + ;; key (usually labeled "Alt"). + (define-key map "\e[27;13;9~" [C-M-tab]) + (define-key map "\e[27;13;13~" [C-M-return]) + + (define-key map "\e[27;13;39~" [?\C-\M-\']) + (define-key map "\e[27;13;44~" [?\C-\M-,]) + (define-key map "\e[27;13;45~" [?\C-\M--]) + (define-key map "\e[27;13;46~" [?\C-\M-.]) + (define-key map "\e[27;13;47~" [?\C-\M-/]) + (define-key map "\e[27;13;48~" [?\C-\M-0]) + (define-key map "\e[27;13;49~" [?\C-\M-1]) + (define-key map "\e[27;13;50~" [?\C-\M-2]) + (define-key map "\e[27;13;51~" [?\C-\M-3]) + (define-key map "\e[27;13;52~" [?\C-\M-4]) + (define-key map "\e[27;13;53~" [?\C-\M-5]) + (define-key map "\e[27;13;54~" [?\C-\M-6]) + (define-key map "\e[27;13;55~" [?\C-\M-7]) + (define-key map "\e[27;13;56~" [?\C-\M-8]) + (define-key map "\e[27;13;57~" [?\C-\M-9]) + (define-key map "\e[27;13;59~" [?\C-\M-\;]) + (define-key map "\e[27;13;61~" [?\C-\M-=]) + (define-key map "\e[27;13;92~" [?\C-\M-\\]) + + (define-key map "\e[27;14;33~" [?\C-\M-!]) + (define-key map "\e[27;14;34~" [?\C-\M-\"]) + (define-key map "\e[27;14;35~" [?\C-\M-#]) + (define-key map "\e[27;14;36~" [?\C-\M-$]) + (define-key map "\e[27;14;37~" [?\C-\M-%]) + (define-key map "\e[27;14;38~" [?\C-\M-&]) + (define-key map "\e[27;14;40~" [?\C-\M-\(]) + (define-key map "\e[27;14;41~" [?\C-\M-\)]) + (define-key map "\e[27;14;42~" [?\C-\M-*]) + (define-key map "\e[27;14;43~" [?\C-\M-+]) + (define-key map "\e[27;14;58~" [?\C-\M-:]) + (define-key map "\e[27;14;60~" [?\C-\M-<]) + (define-key map "\e[27;14;62~" [?\C-\M->]) + (define-key map "\e[27;14;63~" [(control meta ??)]) + + (define-key map "\e[27;7;9~" [C-M-tab]) + (define-key map "\e[27;7;13~" [C-M-return]) + + (define-key map "\e[27;7;32~" [?\C-\M-\s]) + (define-key map "\e[27;7;39~" [?\C-\M-\']) + (define-key map "\e[27;7;44~" [?\C-\M-,]) + (define-key map "\e[27;7;45~" [?\C-\M--]) + (define-key map "\e[27;7;46~" [?\C-\M-.]) + (define-key map "\e[27;7;47~" [?\C-\M-/]) + (define-key map "\e[27;7;48~" [?\C-\M-0]) + (define-key map "\e[27;7;49~" [?\C-\M-1]) + (define-key map "\e[27;7;50~" [?\C-\M-2]) + (define-key map "\e[27;7;51~" [?\C-\M-3]) + (define-key map "\e[27;7;52~" [?\C-\M-4]) + (define-key map "\e[27;7;53~" [?\C-\M-5]) + (define-key map "\e[27;7;54~" [?\C-\M-6]) + (define-key map "\e[27;7;55~" [?\C-\M-7]) + (define-key map "\e[27;7;56~" [?\C-\M-8]) + (define-key map "\e[27;7;57~" [?\C-\M-9]) + (define-key map "\e[27;7;59~" [?\C-\M-\;]) + (define-key map "\e[27;7;61~" [?\C-\M-=]) + (define-key map "\e[27;7;92~" [?\C-\M-\\]) + + (define-key map "\e[27;8;33~" [?\C-\M-!]) + (define-key map "\e[27;8;34~" [?\C-\M-\"]) + (define-key map "\e[27;8;35~" [?\C-\M-#]) + (define-key map "\e[27;8;36~" [?\C-\M-$]) + (define-key map "\e[27;8;37~" [?\C-\M-%]) + (define-key map "\e[27;8;38~" [?\C-\M-&]) + (define-key map "\e[27;8;40~" [?\C-\M-\(]) + (define-key map "\e[27;8;41~" [?\C-\M-\)]) + (define-key map "\e[27;8;42~" [?\C-\M-*]) + (define-key map "\e[27;8;43~" [?\C-\M-+]) + (define-key map "\e[27;8;58~" [?\C-\M-:]) + (define-key map "\e[27;8;60~" [?\C-\M-<]) + (define-key map "\e[27;8;62~" [?\C-\M->]) + (define-key map "\e[27;8;63~" [(control meta ??)]) + + (define-key map "\e[27;2;9~" [S-tab]) + (define-key map "\e[27;2;13~" [S-return]) + + (define-key map "\e[27;6;9~" [C-S-tab]) + (define-key map "\e[27;6;13~" [C-S-return]) + + ;; 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]) + (define-key map "\eO2B" [S-down]) + (define-key map "\eO2C" [S-right]) + (define-key map "\eO2D" [S-left]) + (define-key map "\eO2F" [S-end]) + (define-key map "\eO2H" [S-home]) + + (define-key map "\eO5A" [C-up]) + (define-key map "\eO5B" [C-down]) + (define-key map "\eO5C" [C-right]) + (define-key map "\eO5D" [C-left]) + (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]) + map) + "Function key map overrides for xterm.") + +(defvar xterm-alternatives-map + (let ((map (make-sparse-keymap))) + ;; The terminal initialization C code file might have initialized + ;; function keys F13->F60 from the termcap/terminfo information. + ;; On a PC-style keyboard these keys correspond to + ;; MODIFIER-FUNCTION_KEY, where modifier is S-, C, A-, C-S-. The code + ;; here substitutes the corresponding definitions in function-key-map. + ;; The mapping from escape sequences to Fn is done in input-decode-map + ;; whereas this here mapping is done in local-function-key-map so that + ;; bindings to f45 still work, in case your keyboard really has an f45 + ;; key rather than C-S-f9. + (define-key map [f13] [S-f1]) + (define-key map [f14] [S-f2]) + (define-key map [f15] [S-f3]) + (define-key map [f16] [S-f4]) + (define-key map [f17] [S-f5]) + (define-key map [f18] [S-f6]) + (define-key map [f19] [S-f7]) + (define-key map [f20] [S-f8]) + (define-key map [f21] [S-f9]) + (define-key map [f22] [S-f10]) + (define-key map [f23] [S-f11]) + (define-key map [f24] [S-f12]) + + (define-key map [f25] [C-f1]) + (define-key map [f26] [C-f2]) + (define-key map [f27] [C-f3]) + (define-key map [f28] [C-f4]) + (define-key map [f29] [C-f5]) + (define-key map [f30] [C-f6]) + (define-key map [f31] [C-f7]) + (define-key map [f32] [C-f8]) + (define-key map [f33] [C-f9]) + (define-key map [f34] [C-f10]) + (define-key map [f35] [C-f11]) + (define-key map [f36] [C-f12]) + + (define-key map [f37] [C-S-f1]) + (define-key map [f38] [C-S-f2]) + (define-key map [f39] [C-S-f3]) + (define-key map [f40] [C-S-f4]) + (define-key map [f41] [C-S-f5]) + (define-key map [f42] [C-S-f6]) + (define-key map [f43] [C-S-f7]) + (define-key map [f44] [C-S-f8]) + (define-key map [f45] [C-S-f9]) + (define-key map [f46] [C-S-f10]) + (define-key map [f47] [C-S-f11]) + (define-key map [f48] [C-S-f12]) + + (define-key map [f49] [M-f1]) + (define-key map [f50] [M-f2]) + (define-key map [f51] [M-f3]) + (define-key map [f52] [M-f4]) + (define-key map [f53] [M-f5]) + (define-key map [f54] [M-f6]) + (define-key map [f55] [M-f7]) + (define-key map [f56] [M-f8]) + (define-key map [f57] [M-f9]) + (define-key map [f58] [M-f10]) + (define-key map [f59] [M-f11]) + (define-key map [f60] [M-f12]) + + map) + "Keymap of possible alternative meanings for some keys.") + +;; List of terminals for which modify-other-keys has been turned on. +(defvar xterm-modify-other-keys-terminal-list nil) + (defun terminal-init-xterm () "Terminal initialization function for xterm." ;; rxvt terminals sometimes set the TERM variable to "xterm", but - ;; rxvt's keybindings that are incompatible with xterm's. It is + ;; rxvt's keybindings are incompatible with xterm's. It is ;; better in that case to use rxvt's initializion function. - (if (and (getenv "COLORTERM") - (string-match "\\`rxvt" (getenv "COLORTERM"))) - (progn - (eval-and-compile (load "term/rxvt")) - (terminal-init-rxvt)) - - ;; The terminal intialization C code file might have initialized - ;; function keys F13->F60 from the termcap/terminfo information. On - ;; a PC-style keyboard these keys correspond to - ;; MODIFIER-FUNCTION_KEY, where modifier is S-, C, A-, C-S-. The - ;; code here subsitutes the corresponding defintions in - ;; function-key-map. This substitution is needed because if a key - ;; definition is found in function-key-map, there are no further - ;; lookups in other keymaps. - (substitute-key-definition [f13] [S-f1] function-key-map) - (substitute-key-definition [f14] [S-f2] function-key-map) - (substitute-key-definition [f15] [S-f3] function-key-map) - (substitute-key-definition [f16] [S-f4] function-key-map) - (substitute-key-definition [f17] [S-f5] function-key-map) - (substitute-key-definition [f18] [S-f6] function-key-map) - (substitute-key-definition [f19] [S-f7] function-key-map) - (substitute-key-definition [f20] [S-f8] function-key-map) - (substitute-key-definition [f21] [S-f9] function-key-map) - (substitute-key-definition [f22] [S-f10] function-key-map) - (substitute-key-definition [f23] [S-f11] function-key-map) - (substitute-key-definition [f24] [S-f12] function-key-map) - - (substitute-key-definition [f25] [C-f1] function-key-map) - (substitute-key-definition [f26] [C-f2] function-key-map) - (substitute-key-definition [f27] [C-f3] function-key-map) - (substitute-key-definition [f28] [C-f4] function-key-map) - (substitute-key-definition [f29] [C-f5] function-key-map) - (substitute-key-definition [f30] [C-f6] function-key-map) - (substitute-key-definition [f31] [C-f7] function-key-map) - (substitute-key-definition [f32] [C-f8] function-key-map) - (substitute-key-definition [f33] [C-f9] function-key-map) - (substitute-key-definition [f34] [C-f10] function-key-map) - (substitute-key-definition [f35] [C-f11] function-key-map) - (substitute-key-definition [f36] [C-f12] function-key-map) - - (substitute-key-definition [f37] [C-S-f1] function-key-map) - (substitute-key-definition [f38] [C-S-f2] function-key-map) - (substitute-key-definition [f39] [C-S-f3] function-key-map) - (substitute-key-definition [f40] [C-S-f4] function-key-map) - (substitute-key-definition [f41] [C-S-f5] function-key-map) - (substitute-key-definition [f42] [C-S-f6] function-key-map) - (substitute-key-definition [f43] [C-S-f7] function-key-map) - (substitute-key-definition [f44] [C-S-f8] function-key-map) - (substitute-key-definition [f45] [C-S-f9] function-key-map) - (substitute-key-definition [f46] [C-S-f10] function-key-map) - (substitute-key-definition [f47] [C-S-f11] function-key-map) - (substitute-key-definition [f48] [C-S-f12] function-key-map) - - (substitute-key-definition [f49] [A-f1] function-key-map) - (substitute-key-definition [f50] [A-f2] function-key-map) - (substitute-key-definition [f51] [A-f3] function-key-map) - (substitute-key-definition [f52] [A-f4] function-key-map) - (substitute-key-definition [f53] [A-f5] function-key-map) - (substitute-key-definition [f54] [A-f6] function-key-map) - (substitute-key-definition [f55] [A-f7] function-key-map) - (substitute-key-definition [f56] [A-f8] function-key-map) - (substitute-key-definition [f57] [A-f9] function-key-map) - (substitute-key-definition [f58] [A-f10] function-key-map) - (substitute-key-definition [f59] [A-f11] function-key-map) - (substitute-key-definition [f60] [A-f12] function-key-map) - - (let ((map (make-sparse-keymap))) - ;; 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[23~" [f11]) - (define-key map "\e[24~" [f12]) - - (define-key map "\eO2P" [S-f1]) - (define-key map "\eO2Q" [S-f2]) - (define-key map "\eO2R" [S-f3]) - (define-key map "\eO2S" [S-f4]) - (define-key map "\e[1;2P" [S-f1]) - (define-key map "\e[1;2Q" [S-f2]) - (define-key map "\e[1;2R" [S-f3]) - (define-key map "\e[1;2S" [S-f4]) - (define-key map "\e[15;2~" [S-f5]) - (define-key map "\e[17;2~" [S-f6]) - (define-key map "\e[18;2~" [S-f7]) - (define-key map "\e[19;2~" [S-f8]) - (define-key map "\e[20;2~" [S-f9]) - (define-key map "\e[21;2~" [S-f10]) - (define-key map "\e[23;2~" [S-f11]) - (define-key map "\e[24;2~" [S-f12]) - - (define-key map "\eO5P" [C-f1]) - (define-key map "\eO5Q" [C-f2]) - (define-key map "\eO5R" [C-f3]) - (define-key map "\eO5S" [C-f4]) - (define-key map "\e[15;5~" [C-f5]) - (define-key map "\e[17;5~" [C-f6]) - (define-key map "\e[18;5~" [C-f7]) - (define-key map "\e[19;5~" [C-f8]) - (define-key map "\e[20;5~" [C-f9]) - (define-key map "\e[21;5~" [C-f10]) - (define-key map "\e[23;5~" [C-f11]) - (define-key map "\e[24;5~" [C-f12]) - - (define-key map "\eO6P" [C-S-f1]) - (define-key map "\eO6Q" [C-S-f2]) - (define-key map "\eO6R" [C-S-f3]) - (define-key map "\eO6S" [C-S-f4]) - (define-key map "\e[15;6~" [C-S-f5]) - (define-key map "\e[17;6~" [C-S-f6]) - (define-key map "\e[18;6~" [C-S-f7]) - (define-key map "\e[19;6~" [C-S-f8]) - (define-key map "\e[20;6~" [C-S-f9]) - (define-key map "\e[21;6~" [C-S-f10]) - (define-key map "\e[23;6~" [C-S-f11]) - (define-key map "\e[24;6~" [C-S-f12]) - - (define-key map "\eO3P" [A-f1]) - (define-key map "\eO3Q" [A-f2]) - (define-key map "\eO3R" [A-f3]) - (define-key map "\eO3S" [A-f4]) - (define-key map "\e[15;3~" [A-f5]) - (define-key map "\e[17;3~" [A-f6]) - (define-key map "\e[18;3~" [A-f7]) - (define-key map "\e[19;3~" [A-f8]) - (define-key map "\e[20;3~" [A-f9]) - (define-key map "\e[21;3~" [A-f10]) - (define-key map "\e[23;3~" [A-f11]) - (define-key map "\e[24;3~" [A-f12]) - - (define-key map "\eO4P" [M-S-f1]) - (define-key map "\eO4Q" [M-S-f2]) - (define-key map "\eO4R" [M-S-f3]) - (define-key map "\eO4S" [M-S-f4]) - (define-key map "\e[15;4~" [M-S-f5]) - (define-key map "\e[17;4~" [M-S-f6]) - (define-key map "\e[18;4~" [M-S-f7]) - (define-key map "\e[19;4~" [M-S-f8]) - (define-key map "\e[20;4~" [M-S-f9]) - (define-key map "\e[21;4~" [M-S-f10]) - (define-key map "\e[23;4~" [M-S-f11]) - (define-key map "\e[24;4~" [M-S-f12]) - - (define-key map "\eOA" [up]) - (define-key map "\eOB" [down]) - (define-key map "\eOC" [right]) - (define-key map "\eOD" [left]) - (define-key map "\eOF" [end]) - (define-key map "\eOH" [home]) - - (define-key map "\e[1;2A" [S-up]) - (define-key map "\e[1;2B" [S-down]) - (define-key map "\e[1;2C" [S-right]) - (define-key map "\e[1;2D" [S-left]) - (define-key map "\e[1;2F" [S-end]) - (define-key map "\e[1;2H" [S-home]) - - (define-key map "\e[1;4A" [M-S-up]) - (define-key map "\e[1;4B" [M-S-down]) - (define-key map "\e[1;4C" [M-S-right]) - (define-key map "\e[1;4D" [M-S-left]) - (define-key map "\e[1;4F" [M-S-end]) - (define-key map "\e[1;4H" [M-S-home]) - - (define-key map "\e[1;5A" [C-up]) - (define-key map "\e[1;5B" [C-down]) - (define-key map "\e[1;5C" [C-right]) - (define-key map "\e[1;5D" [C-left]) - (define-key map "\e[1;5F" [C-end]) - (define-key map "\e[1;5H" [C-home]) - - (define-key map "\e[1;6A" [C-S-up]) - (define-key map "\e[1;6B" [C-S-down]) - (define-key map "\e[1;6C" [C-S-right]) - (define-key map "\e[1;6D" [C-S-left]) - (define-key map "\e[1;6F" [C-S-end]) - (define-key map "\e[1;6H" [C-S-home]) - - (define-key map "\e[1;7A" [C-M-up]) - (define-key map "\e[1;7B" [C-M-down]) - (define-key map "\e[1;7C" [C-M-right]) - (define-key map "\e[1;7D" [C-M-left]) - (define-key map "\e[1;7F" [C-M-end]) - (define-key map "\e[1;7H" [C-M-home]) - - (define-key map "\e[1;8A" [C-M-S-up]) - (define-key map "\e[1;8B" [C-M-S-down]) - (define-key map "\e[1;8C" [C-M-S-right]) - (define-key map "\e[1;8D" [C-M-S-left]) - (define-key map "\e[1;8F" [C-M-S-end]) - (define-key map "\e[1;8H" [C-M-S-home]) - - (define-key map "\e[1;3A" [A-up]) - (define-key map "\e[1;3B" [A-down]) - (define-key map "\e[1;3C" [A-right]) - (define-key map "\e[1;3D" [A-left]) - (define-key map "\e[1;3F" [A-end]) - (define-key map "\e[1;3H" [A-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]) - - (define-key map "\e[2;4~" [M-S-insert]) - (define-key map "\e[3;4~" [M-S-delete]) - (define-key map "\e[5;4~" [M-S-prior]) - (define-key map "\e[6;4~" [M-S-next]) - - (define-key map "\e[2;5~" [C-insert]) - (define-key map "\e[3;5~" [C-delete]) - (define-key map "\e[5;5~" [C-prior]) - (define-key map "\e[6;5~" [C-next]) - - (define-key map "\e[2;6~" [C-S-insert]) - (define-key map "\e[3;6~" [C-S-delete]) - (define-key map "\e[5;6~" [C-S-prior]) - (define-key map "\e[6;6~" [C-S-next]) - - (define-key map "\e[2;7~" [C-M-insert]) - (define-key map "\e[3;7~" [C-M-delete]) - (define-key map "\e[5;7~" [C-M-prior]) - (define-key map "\e[6;7~" [C-M-next]) - - (define-key map "\e[2;8~" [C-M-S-insert]) - (define-key map "\e[3;8~" [C-M-S-delete]) - (define-key map "\e[5;8~" [C-M-S-prior]) - (define-key map "\e[6;8~" [C-M-S-next]) - - (define-key map "\e[2;3~" [A-insert]) - (define-key map "\e[3;3~" [A-delete]) - (define-key map "\e[5;3~" [A-prior]) - (define-key map "\e[6;3~" [A-next]) - - (define-key map "\e[4~" [select]) - (define-key map "\e[29~" [print]) - - (define-key map "\eOj" [kp-multiply]) - (define-key map "\eOk" [kp-add]) - (define-key map "\eOl" [kp-separator]) - (define-key map "\eOm" [kp-subtract]) - (define-key map "\eOo" [kp-divide]) - (define-key map "\eOp" [kp-0]) - (define-key map "\eOq" [kp-1]) - (define-key map "\eOr" [kp-2]) - (define-key map "\eOs" [kp-3]) - (define-key map "\eOt" [kp-4]) - (define-key map "\eOu" [kp-5]) - (define-key map "\eOv" [kp-6]) - (define-key map "\eOw" [kp-7]) - (define-key map "\eOx" [kp-8]) - (define-key map "\eOy" [kp-9]) - - ;; These keys are available in xterm starting from version 216 - ;; if the modifyOtherKeys resource is set to 1. - - (define-key map "\e[27;5;9~" [C-tab]) - (define-key map "\e[27;5;13~" [C-return]) - (define-key map "\e[27;5;39~" [?\C-\']) - (define-key map "\e[27;5;44~" [?\C-,]) - (define-key map "\e[27;5;45~" [?\C--]) - (define-key map "\e[27;5;46~" [?\C-.]) - (define-key map "\e[27;5;47~" [?\C-/]) - (define-key map "\e[27;5;48~" [?\C-0]) - (define-key map "\e[27;5;49~" [?\C-1]) - ;; Not all C-DIGIT keys have a distinct binding. - (define-key map "\e[27;5;57~" [?\C-9]) - (define-key map "\e[27;5;59~" [?\C-\;]) - (define-key map "\e[27;5;61~" [?\C-=]) - (define-key map "\e[27;5;92~" [?\C-\\]) - - (define-key map "\e[27;6;33~" [?\C-!]) - (define-key map "\e[27;6;34~" [?\C-\"]) - (define-key map "\e[27;6;35~" [?\C-#]) - (define-key map "\e[27;6;36~" [?\C-$]) - (define-key map "\e[27;6;37~" [?\C-%]) - (define-key map "\e[27;6;38~" [?\C-&]) - (define-key map "\e[27;6;40~" [?\C-\(]) - (define-key map "\e[27;6;41~" [?\C-\)]) - (define-key map "\e[27;6;42~" [?\C-*]) - (define-key map "\e[27;6;43~" [?\C-+]) - (define-key map "\e[27;6;58~" [?\C-:]) - (define-key map "\e[27;6;60~" [?\C-<]) - (define-key map "\e[27;6;62~" [?\C->]) - (define-key map "\e[27;6;63~" [(control ??)]) - - ;; These are the strings emitted for various C-M- combinations - ;; for keyboards that the Meta and Alt modifiers are on the same - ;; key (usually labeled "Alt"). - (define-key map "\e[27;13;9~" [C-M-tab]) - (define-key map "\e[27;13;13~" [C-M-return]) - - (define-key map "\e[27;13;39~" [?\C-\M-\']) - (define-key map "\e[27;13;44~" [?\C-\M-,]) - (define-key map "\e[27;13;45~" [?\C-\M--]) - (define-key map "\e[27;13;46~" [?\C-\M-.]) - (define-key map "\e[27;13;47~" [?\C-\M-/]) - (define-key map "\e[27;13;48~" [?\C-\M-0]) - (define-key map "\e[27;13;49~" [?\C-\M-1]) - (define-key map "\e[27;13;50~" [?\C-\M-2]) - (define-key map "\e[27;13;51~" [?\C-\M-3]) - (define-key map "\e[27;13;52~" [?\C-\M-4]) - (define-key map "\e[27;13;53~" [?\C-\M-5]) - (define-key map "\e[27;13;54~" [?\C-\M-6]) - (define-key map "\e[27;13;55~" [?\C-\M-7]) - (define-key map "\e[27;13;56~" [?\C-\M-8]) - (define-key map "\e[27;13;57~" [?\C-\M-9]) - (define-key map "\e[27;13;59~" [?\C-\M-\;]) - (define-key map "\e[27;13;61~" [?\C-\M-=]) - (define-key map "\e[27;13;92~" [?\C-\M-\\]) - - (define-key map "\e[27;14;33~" [?\C-\M-!]) - (define-key map "\e[27;14;34~" [?\C-\M-\"]) - (define-key map "\e[27;14;35~" [?\C-\M-#]) - (define-key map "\e[27;14;36~" [?\C-\M-$]) - (define-key map "\e[27;14;37~" [?\C-\M-%]) - (define-key map "\e[27;14;38~" [?\C-\M-&]) - (define-key map "\e[27;14;40~" [?\C-\M-\(]) - (define-key map "\e[27;14;41~" [?\C-\M-\)]) - (define-key map "\e[27;14;42~" [?\C-\M-*]) - (define-key map "\e[27;14;43~" [?\C-\M-+]) - (define-key map "\e[27;14;58~" [?\C-\M-:]) - (define-key map "\e[27;14;60~" [?\C-\M-<]) - (define-key map "\e[27;14;62~" [?\C-\M->]) - (define-key map "\e[27;14;63~" [(control meta ??)]) - - (define-key map "\e[27;7;9~" [C-M-tab]) - (define-key map "\e[27;7;13~" [C-M-return]) - - (define-key map "\e[27;7;32~" [?\C-\M-\s]) - (define-key map "\e[27;7;39~" [?\C-\M-\']) - (define-key map "\e[27;7;44~" [?\C-\M-,]) - (define-key map "\e[27;7;45~" [?\C-\M--]) - (define-key map "\e[27;7;46~" [?\C-\M-.]) - (define-key map "\e[27;7;47~" [?\C-\M-/]) - (define-key map "\e[27;7;48~" [?\C-\M-0]) - (define-key map "\e[27;7;49~" [?\C-\M-1]) - (define-key map "\e[27;7;50~" [?\C-\M-2]) - (define-key map "\e[27;7;51~" [?\C-\M-3]) - (define-key map "\e[27;7;52~" [?\C-\M-4]) - (define-key map "\e[27;7;53~" [?\C-\M-5]) - (define-key map "\e[27;7;54~" [?\C-\M-6]) - (define-key map "\e[27;7;55~" [?\C-\M-7]) - (define-key map "\e[27;7;56~" [?\C-\M-8]) - (define-key map "\e[27;7;57~" [?\C-\M-9]) - (define-key map "\e[27;7;59~" [?\C-\M-\;]) - (define-key map "\e[27;7;61~" [?\C-\M-=]) - (define-key map "\e[27;7;92~" [?\C-\M-\\]) - - (define-key map "\e[27;8;33~" [?\C-\M-!]) - (define-key map "\e[27;8;34~" [?\C-\M-\"]) - (define-key map "\e[27;8;35~" [?\C-\M-#]) - (define-key map "\e[27;8;36~" [?\C-\M-$]) - (define-key map "\e[27;8;37~" [?\C-\M-%]) - (define-key map "\e[27;8;38~" [?\C-\M-&]) - (define-key map "\e[27;8;40~" [?\C-\M-\(]) - (define-key map "\e[27;8;41~" [?\C-\M-\)]) - (define-key map "\e[27;8;42~" [?\C-\M-*]) - (define-key map "\e[27;8;43~" [?\C-\M-+]) - (define-key map "\e[27;8;58~" [?\C-\M-:]) - (define-key map "\e[27;8;60~" [?\C-\M-<]) - (define-key map "\e[27;8;62~" [?\C-\M->]) - (define-key map "\e[27;8;63~" [(control meta ??)]) - - (define-key map "\e[27;2;9~" [S-tab]) - (define-key map "\e[27;2;13~" [S-return]) - - (define-key map "\e[27;6;9~" [C-S-tab]) - (define-key map "\e[27;6;13~" [C-S-return]) - - ;; 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]) - (define-key map "\eO2B" [S-down]) - (define-key map "\eO2C" [S-right]) - (define-key map "\eO2D" [S-left]) - (define-key map "\eO2F" [S-end]) - (define-key map "\eO2H" [S-home]) - - (define-key map "\eO5A" [C-up]) - (define-key map "\eO5B" [C-down]) - (define-key map "\eO5C" [C-right]) - (define-key map "\eO5D" [C-left]) - (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]) + (if (and (getenv "COLORTERM" (selected-frame)) + (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)) + + (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 .emacs file. - (set-keymap-parent map (keymap-parent function-key-map)) - (set-keymap-parent function-key-map map)) + (set-keymap-parent map (keymap-parent input-decode-map)) + (set-keymap-parent input-decode-map map))) - ;; Do it! (xterm-register-default-colors) ;; This recomputes all the default faces given the colors we've just set up. - (tty-set-up-initial-frame-faces))) + (tty-set-up-initial-frame-faces) + + ;; Try to turn on the modifyOtherKeys feature on modern xterms. + ;; When it is turned on many more key bindings work: things like + ;; C-. C-, etc. + ;; To do that we need to find out if the current terminal supports + ;; modifyOtherKeys. At this time only xterm does. + (let ((coding-system-for-read 'binary) + (chr nil) + (str nil)) + ;; Try to find out the type of terminal by sending a "Secondary + ;; Device Attributes (DA)" query. + (send-string-to-terminal "\e[>0c") + + ;; The reply should be of the form: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c + ;; If the timeout is completely removed for read-event, this + ;; might hang for terminals that pretend to be xterm, but don't + ;; respond to this escape sequence. RMS' opinion was to remove + ;; it completely. That might be right, but let's first try to + ;; see if by using a longer timeout we get rid of most issues. + (when (equal (read-event nil nil 2) ?\e) + (when (equal (read-event nil nil 2) ?\[) + (while (not (equal (setq chr (read-event nil nil 2)) ?c)) + (setq str (concat str (string chr)))) + (when (string-match ">0;\\([0-9]+\\);0" str) + ;; NUMBER2 is the xterm version number, look for something + ;; greater than 216, the version when modifyOtherKeys was + ;; introduced. + (when (>= (string-to-number + (substring str (match-beginning 1) (match-end 1))) 216) + ;; Make sure that the modifyOtherKeys state is restored when + ;; suspending, resuming and exiting. + (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys) + (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys) + (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys) + (add-hook 'delete-frame-hook 'xterm-remove-modify-other-keys) + ;; Add the selected frame to the list of frames that + ;; need to deal with modify-other-keys. + (push (frame-terminal (selected-frame)) + xterm-modify-other-keys-terminal-list) + (xterm-turn-on-modify-other-keys)))))) + + (run-hooks 'terminal-init-xterm-hook)) ;; Set up colors, for those versions of xterm that support it. (defvar xterm-standard-colors @@ -486,7 +544,7 @@ for the currently selected frame. The first 16 colors are taken from `xterm-standard-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)) + (let* ((ncolors (display-color-cells (selected-frame))) (colors xterm-standard-colors) (color (car colors))) (if (> ncolors 0) @@ -567,5 +625,29 @@ versions of xterm." ;; right colors, so clear them. (clear-face-cache))) +(defun xterm-turn-on-modify-other-keys () + "Turn on the modifyOtherKeys feature of xterm." + (let ((frame (selected-frame))) + (when (and (frame-live-p frame) + (memq frame xterm-modify-other-keys-terminal-list)) + (send-string-to-terminal "\e[>4;1m")))) + +(defun xterm-turn-off-modify-other-keys (&optional frame) + "Turn off the modifyOtherKeys feature of xterm." + (setq frame (and frame (selected-frame))) + (when (and (frame-live-p frame) + (memq frame xterm-modify-other-keys-terminal-list)) + (send-string-to-terminal "\e[>4m"))) + +(defun xterm-remove-modify-other-keys (&optional frame) + "Turn off the modifyOtherKeys feature of xterm and remove frame from consideration." + (setq frame (and frame (selected-frame))) + (when (and (frame-live-p frame) + (memq frame xterm-modify-other-keys-terminal-list)) + (setq xterm-modify-other-keys-terminal-list + (delq (frame-terminal frame) + xterm-modify-other-keys-terminal-list)) + (send-string-to-terminal "\e[>4m"))) + ;; arch-tag: 12e7ebdd-1e6c-4b25-b0f9-35ace25e855a ;;; xterm.el ends here |