diff options
Diffstat (limited to 'lisp')
66 files changed, 3884 insertions, 2328 deletions
diff --git a/lisp/ChangeLog.multi-tty b/lisp/ChangeLog.multi-tty new file mode 100644 index 00000000000..51ab6683323 --- /dev/null +++ b/lisp/ChangeLog.multi-tty @@ -0,0 +1,140 @@ +2007-07-29 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Fix merge issue. + +2007-07-02 Dan Nicolaescu <dann@ics.uci.edu> + + * env.el (read-envvar-name): Don't consider the environment frame + param. + (setenv): Set display-environment-variable and + term-environment-variable. + + * frame.el (frame-initialize, make-frame): Likewise. + + * faces.el (tty-set-up-initial-frame-faces): Likewise. + + * server.el (server-process-filter): Likewise. + (server-process-filter): Likewise. Also set COLORFGBG and + COLORTERM. + + * term/x-win.el (x-menu-bar-open): Use accelerate-menu. + +2007-06-23 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Fix previous change. + +2007-06-18 Dan Nicolaescu <dann@ics.uci.edu> + + * term/xterm.el (terminal-init-xterm): Revert bad merge from trunk. + +2007-06-12 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-process-filter): Fix typo in docstring. + +2007-06-03 Dan Nicolaescu <dann@ics.uci.edu> + + * loadup.el: Use a better feature test on a mac. + +2007-05-20 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu> + + * server.el (server-process-filter): Don't change + default-directory in *scratch*. + + * mail/emacsbug.el (report-emacs-bug-pretest-address): Revert to + official Emacs pretest bug report address. + +2007-05-19 Dan Nicolaescu <dann@ics.uci.edu> + + * term/mac-win.el: Provide mac-win. + (mac-initialized): New variable. + (mac-initialize-window-system): New function. Move global setup + here. + (handle-args-function-alist, frame-creation-function-alist): + (window-system-initialization-alist): Add mac entries. + (x-setup-function-keys): New function containing all the + top level function key definitions. + + * loadup.el: Load mac-win on a Mac. Avoid loading both x-win and + mac-win. + +2007-05-17 Jason Rumney <jasonr@gnu.org> + + * term/w32-win.el (internal-face-interactive): Remove obsolete function. + +2007-05-16 Jason Rumney <jasonr@gnu.org> + + * term/w32-win.el: Reorder to match x-win.el more closely. + (x-setup-function-keys): Use local-function-key-map. + (w32-initialized): New variable. + (w32-initialize-window-system): Set it. + Move more global setup here. + +2007-05-16 Jason Rumney <jasonr@gnu.org> + + * term/w32-win.el (x-setup-function-keys): New function. + (w32-initialize-window-system): Move non function key global setup + here. + +2007-05-16 Jason Rumney <jasonr@gnu.org> + + * term/w32-win.el: Provide w32-win. + Don't throw error when global window-system not w32. + (x-cut-buffer-max): Remove. + (w32-initialize-window-system): New function. + (handle-args-function-alist, frame-creation-function-alist): + (window-system-initialization-alist): Add w32 entries. + + * loadup.el: Only load x-dnd and x-win when X is compiled in. + Load w32-win and dependencies on windows-nt. + +2007-05-16 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu> + + * env.el (getenv): Restore David Kastrup's fix. + (environment): Add optional frame parameter. + + * mule-cmds.el (set-locale-environment): Fix getenv call. + * term/rxvt.el (rxvt-set-background-mode): Ditto. + * x-win.el (x-initialize-window-system, terminal-init-xterm): Ditto. + + * server.el (server-with-environment): Restore the original + environment. + +2007-05-14 David Kastrup <dak@gnu.org> + + * env.el (getenv): Fix reverted by demand of Dan Nicolaescu + because it exposes further problems. + +2007-05-13 David Kastrup <dak@gnu.org> + + * env.el (getenv): Pass frame to getenv-internal. + +2007-05-12 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu> + + This placeholder will be replaced by the Arch logs of the + multi-tty branch. + +;; Local Variables: +;; coding: iso-2022-7bit +;; add-log-time-zone-rule: t +;; End: + + Copyright (C) 2007 Free Software Foundation, Inc. + + 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 2, 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. + +;;; arch-tag: 58312fd6-033a-11dc-a0fb-00114368b55b diff --git a/lisp/bindings.el b/lisp/bindings.el index 75dd33767b6..38184ae88a4 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -170,6 +170,12 @@ corresponding to the mode line clicked." (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache) desc))) +(defvar mode-line-client + `("" + (:propertize ("" (:eval (if (frame-parameter nil 'client) "@" ""))) + help-echo "Emacsclient frame")) + "Mode-line control for identifying Emacsclient frames.") + (defvar mode-line-mule-info `("" (current-input-method @@ -209,7 +215,7 @@ mnemonics of the following coding systems: (make-variable-buffer-local 'mode-line-mule-info) -(defvar mode-line-frame-identification '("-%F ") +(defvar mode-line-frame-identification '(window-system " " "-%F ") "Mode-line control to describe the current frame.") (defvar mode-line-process nil "\ @@ -302,6 +308,7 @@ Keymap to display on minor modes.") "%e" (propertize "-" 'help-echo help-echo) 'mode-line-mule-info + 'mode-line-client 'mode-line-modified 'mode-line-remote 'mode-line-frame-identification @@ -331,6 +338,7 @@ Keymap to display on minor modes.") 'local-map (make-mode-line-mouse-map 'mouse-2 #'mode-line-widen)) (propertize ")%]--" 'help-echo help-echo))) + (standard-mode-line-position `((-3 ,(propertize "%p" 'help-echo help-echo)) (size-indication-mode diff --git a/lisp/cus-face.el b/lisp/cus-face.el index be88b499fef..900a815b160 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -40,15 +40,18 @@ (when (fboundp 'facep) (unless (facep face) ;; If the user has already created the face, respect that. - (let ((value (or (get face 'saved-face) spec))) + (let ((value (or (get face 'saved-face) spec)) + (have-window-system (memq initial-window-system '(x w32)))) ;; Create global face. (make-empty-face face) ;; Create frame-local faces (dolist (frame (frame-list)) - (face-spec-set face value frame))) - ;; When making a face after frames already exist - (if (memq window-system '(x w32 mac)) - (make-face-x-resource-internal face)))) + (face-spec-set face value frame) + (when (memq (window-system frame) '(x w32 mac)) + (setq have-window-system t))) + ;; When making a face after frames already exist + (if have-window-system + (make-face-x-resource-internal face))))) ;; Don't record SPEC until we see it causes no errors. (put face 'face-defface-spec spec) (push (cons 'defface face) current-load-list) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index b83f26fc12f..e2cb65c82c4 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -422,14 +422,10 @@ since it could result in memory overflow and make Emacs crash." (eq system-type 'ms-dos)) ((string-match "\\`w32-" (symbol-name symbol)) (eq system-type 'windows-nt)) - ((string-match "\\`mac-" (symbol-name symbol)) - (eq window-system 'mac)) + ((string-match "\\`mac-" (symbol-name symbol)) + (or (eq system-type 'mac) (eq system-type 'darwin))) ((string-match "\\`x-.*gtk" (symbol-name symbol)) - (or (boundp 'gtk) - (and window-system - (not (eq window-system 'pc)) - (not (eq window-system 'mac)) - (not (eq system-type 'windows-nt))))) + (featurep 'gtk)) ((string-match "\\`x-" (symbol-name symbol)) (fboundp 'x-create-frame)) ((string-match "selection" (symbol-name symbol)) diff --git a/lisp/double.el b/lisp/double.el index 4b1d59ff1ec..8d36d21b0fa 100644 --- a/lisp/double.el +++ b/lisp/double.el @@ -145,11 +145,12 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (if enable-flag (progn ;; Set up key-translation-map as indicated by `double-map'. + ;; XXX I don't think key-translation-map should be made local here. -- Lorentey (kill-local-variable 'key-translation-map) (make-local-variable 'key-translation-map) (setq key-translation-map (if (keymapp key-translation-map) - (copy-keymap key-translation-map) - (make-sparse-keymap))) + (copy-keymap key-translation-map) + (make-sparse-keymap))) (mapcar (function (lambda (entry) (define-key key-translation-map (vector (nth 0 entry)) diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 744a7ba4617..3b2b17fe188 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -175,7 +175,7 @@ Entry to this mode via command `electric-buffer-list' calls the value of (let ((map (make-keymap))) (fillarray (car (cdr map)) 'Electric-buffer-menu-undefined) (define-key map "\e" nil) - (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-z" 'suspend-frame) (define-key map "v" 'Electric-buffer-menu-mode-view-buffer) (define-key map (char-to-string help-char) 'Helper-help) (define-key map "?" 'Helper-describe-bindings) diff --git a/lisp/echistory.el b/lisp/echistory.el index 8d5b5e2beea..7468dd0b7fd 100644 --- a/lisp/echistory.el +++ b/lisp/echistory.el @@ -66,7 +66,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing." (define-key electric-history-map "\C-c" nil) (define-key electric-history-map "\C-c\C-c" 'Electric-history-quit) (define-key electric-history-map "\C-]" 'Electric-history-quit) - (define-key electric-history-map "\C-z" 'suspend-emacs) + (define-key electric-history-map "\C-z" 'suspend-frame) (define-key electric-history-map (char-to-string help-char) 'Helper-help) (define-key electric-history-map "?" 'Helper-describe-bindings) (define-key electric-history-map "\e>" 'end-of-buffer) diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el index 897845c182a..c2c130ac6bb 100644 --- a/lisp/ediff-wind.el +++ b/lisp/ediff-wind.el @@ -72,15 +72,15 @@ :group 'frames) -(defcustom ediff-window-setup-function (if (ediff-window-display-p) - 'ediff-setup-windows-multiframe - 'ediff-setup-windows-plain) +(defcustom ediff-window-setup-function 'ediff-setup-windows-automatic "*Function called to set up windows. -Ediff provides a choice of two functions: `ediff-setup-windows-plain', for -doing everything in one frame, and `ediff-setup-windows-multiframe', -which sets the control panel in a separate frame. Also, if the latter -function detects that one of the buffers A/B is seen in some other frame, -it will try to keep that buffer in that frame. +Ediff provides a choice of three functions: `ediff-setup-windows-plain', for +doing everything in one frame, `ediff-setup-windows-multiframe', which sets +the control panel in a separate frame, and +`ediff-setup-windows-automatic' (the default), which chooses an appropriate +behaviour based on the current window system. If the multiframe function +detects that one of the buffers A/B is seen in some other frame, it will try +to keep that buffer in that frame. If you don't like the two functions provided---write your own one. The basic guidelines: @@ -94,7 +94,8 @@ The basic guidelines: Buffer C may not be used in jobs that compare only two buffers. If you plan to do something fancy, take a close look at how the two provided functions are written." - :type '(choice (const :tag "Multi Frame" ediff-setup-windows-multiframe) + :type '(choice (const :tag "Automatic" ediff-setup-windows-automatic) + (const :tag "Multi Frame" ediff-setup-windows-multiframe) (const :tag "Single Frame" ediff-setup-windows-plain) (function :tag "Other function")) :group 'ediff-window) @@ -335,6 +336,12 @@ into icons, regardless of the window manager." buffer-A buffer-B buffer-C control-buffer)) (run-hooks 'ediff-after-setup-windows-hook)) +;; Set up windows using the correct method based on the current window system. +(defun ediff-setup-windows-automatic (buffer-A buffer-B buffer-C control-buffer) + (if (ediff-window-display-p) + (ediff-setup-windows-multiframe buffer-A buffer-B buffer-C control-buffer) + (ediff-setup-windows-plain buffer-A buffer-B buffer-C control-buffer))) + ;; Just set up 3 windows. ;; Usually used without windowing systems ;; With windowing, we want to use dedicated frames. diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 15568e8c39c..abd08f4b0b9 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -486,9 +486,9 @@ doubt, use whitespace." (fkey nil) tlen tkey (bind (or (loop for map in maps for b = (lookup-key map key) thereis (and (not (integerp b)) b)) - (and (setq fkey (lookup-key function-key-map rest-mac)) + (and (setq fkey (lookup-key local-function-key-map rest-mac)) (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) - fkey (lookup-key function-key-map tkey)) + fkey (lookup-key local-function-key-map tkey)) (loop for map in maps for b = (lookup-key map fkey) when (and (not (integerp b)) b) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index d0ec55781e7..337be13e2e5 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1236,9 +1236,9 @@ If ARG is the atom `-', scroll upward by nearly full screen." (memq 'shift (event-modifiers (aref (this-single-command-keys) 0))) ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home. - (and (boundp 'function-key-map) - function-key-map - (let ((ev (lookup-key function-key-map + (and (boundp 'local-function-key-map) + local-function-key-map + (let ((ev (lookup-key local-function-key-map (this-single-command-raw-keys)))) (and (vector ev) (symbolp (setq ev (aref ev 0))) diff --git a/lisp/env.el b/lisp/env.el index d04df5e48b6..bebfed3fed6 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -36,6 +36,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + ;; History list for environment variable names. (defvar read-envvar-name-history nil) @@ -52,7 +54,9 @@ If it is also not t, RET does not exit if it does non-null completion." locale-coding-system t) (substring enventry 0 (string-match "=" enventry))))) - process-environment) + (append process-environment + nil ;;(frame-parameter (frame-with-environment) 'environment) + )) nil mustmatch nil 'read-envvar-name-history)) ;; History list for VALUE argument to setenv. @@ -88,27 +92,70 @@ Use `$$' to insert a single dollar sign." start (+ (match-beginning 0) 1))))) string)) -;; Fixme: Should `process-environment' be recoded if LC_CTYPE &c is set? -(defun setenv (variable &optional value substitute-env-vars) +(defun setenv-internal (env variable value keep-empty) + "Set VARIABLE to VALUE in ENV, adding empty entries if KEEP-EMPTY. +Changes ENV by side-effect, and returns its new value." + (let ((pattern (concat "\\`" (regexp-quote variable) "\\(=\\|\\'\\)")) + (case-fold-search nil) + (scan env) + prev found) + ;; Handle deletions from the beginning of the list specially. + (if (and (null value) + (not keep-empty) + env + (stringp (car env)) + (string-match pattern (car env))) + (cdr env) + ;; Try to find existing entry for VARIABLE in ENV. + (while (and scan (stringp (car scan))) + (when (string-match pattern (car scan)) + (if value + (setcar scan (concat variable "=" value)) + (if keep-empty + (setcar scan variable) + (setcdr prev (cdr scan)))) + (setq found t + scan nil)) + (setq prev scan + scan (cdr scan))) + (if (and (not found) (or value keep-empty)) + (cons (if value + (concat variable "=" value) + variable) + env) + env)))) + +;; Fixme: Should the environment be recoded if LC_CTYPE &c is set? + +(defun setenv (variable &optional value substitute-env-vars frame) "Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or nil, the environment variable VARIABLE will be removed. -Interactively, a prefix argument means to unset the variable. -Interactively, the current value (if any) of the variable -appears at the front of the history list when you type in the new value. -Interactively, always replace environment variables in the new value. +Interactively, a prefix argument means to unset the variable, and +otherwise the current value (if any) of the variable appears at +the front of the history list when you type in the new value. +This function always replaces environment variables in the new +value when called interactively. SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment variables in VALUE with `substitute-env-vars', which see. This is normally used only for interactive calls. +If optional parameter FRAME is non-nil, this function modifies +only the frame-local value of VARIABLE on FRAME, ignoring +`process-environment'. Note that frames on the same terminal +device usually share their environment, so calling `setenv' on +one of them affects the others as well. + +If FRAME is nil, `setenv' changes the global value of VARIABLE by +modifying `process-environment'. Note that the global value +overrides any frame-local values. + The return value is the new value of VARIABLE, or nil if it was removed from the environment. -This function works by modifying `process-environment'. - As a special case, setting variable `TZ' calls `set-time-zone-rule' as a side-effect." (interactive @@ -138,47 +185,135 @@ a side-effect." (if (and value (multibyte-string-p value)) (setq value (encode-coding-string value locale-coding-system))) (if (string-match "=" variable) - (error "Environment variable name `%s' contains `='" variable) - (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) - (case-fold-search nil) - (scan process-environment) - found) - (if (string-equal "TZ" variable) - (set-time-zone-rule value)) - (while scan - (cond ((string-match pattern (car scan)) - (setq found t) - (if (eq nil value) - (setq process-environment (delq (car scan) - process-environment)) - (setcar scan (concat variable "=" value))) - (setq scan nil))) - (setq scan (cdr scan))) - (or found - (if value - (setq process-environment - (cons (concat variable "=" value) - process-environment)))))) + (error "Environment variable name `%s' contains `='" variable)) + (if (string-equal "TZ" variable) + (set-time-zone-rule value)) + (if (null frame) + (setq process-environment (setenv-internal process-environment + variable value t)) + (setq frame (frame-with-environment frame)) + (cond + ((string-equal "TERM" variable) + (set-frame-parameter frame 'term-environment-variable value)) + ((string-equal "DISPLAY" variable) + (set-frame-parameter frame 'display-environment-variable value)) + (t + (setq process-environment (setenv-internal process-environment + variable value nil))))) value) -(defun getenv (variable) +(defun getenv (variable &optional frame) "Get the value of environment variable VARIABLE. VARIABLE should be a string. Value is nil if VARIABLE is undefined in the environment. Otherwise, value is a string. -This function consults the variable `process-environment' -for its value." +If optional parameter FRAME is non-nil, then it should be a +frame. This function will look up VARIABLE in its 'environment +parameter. + +Otherwise, this function searches `process-environment' for +VARIABLE. If it is not found there, then it continues the search +in the environment list of the selected frame." (interactive (list (read-envvar-name "Get environment variable: " t))) (let ((value (getenv-internal (if (multibyte-string-p variable) (encode-coding-string variable locale-coding-system) - variable)))) + variable) + frame))) (if (and enable-multibyte-characters value) (setq value (decode-coding-string value locale-coding-system))) (when (interactive-p) (message "%s" (if value value "Not set"))) value)) +(defun environment (&optional frame) + "Return a list of environment variables with their values. +Each entry in the list is a string of the form NAME=VALUE. + +The returned list can not be used to change environment +variables, only read them. See `setenv' to do that. + +If optional parameter FRAME is non-nil, then it should be a +frame. The function returns the environment of that frame. + +The list is constructed by concatenating the elements of +`process-environment' and the 'environment parameter of the +selected frame, and removing duplicated and empty values. + +Non-ASCII characters are encoded according to the initial value of +`locale-coding-system', i.e. the elements must normally be decoded for use. +See `setenv' and `getenv'." + (let* ((env (append process-environment +;; (frame-parameter (frame-with-environment frame) +;; 'environment) + nil)) + (scan env) + prev seen) + ;; Remove unset variables from the beginning of the list. + (while (and env + (or (not (stringp (car env))) + (not (string-match "=" (car env))))) + (or (member (car env) seen) + (setq seen (cons (car env) seen))) + (setq env (cdr env) + scan env)) + (let (name) + (while scan + (cond ((or (not (stringp (car scan))) + (not (string-match "=" (car scan)))) + ;; Unset variable. + (or (member (car scan) seen) + (setq seen (cons (car scan) seen))) + (setcdr prev (cdr scan))) + ((member (setq name (substring (car scan) 0 (string-match "=" (car scan)))) seen) + ;; Duplicated variable. + (setcdr prev (cdr scan))) + (t + ;; New variable. + (setq seen (cons name seen)))) + (setq prev scan + scan (cdr scan)))) + env)) + +(defmacro let-environment (varlist &rest body) + "Evaluate BODY with environment variables set according to VARLIST. +The environment variables are then restored to their previous +values. +The value of the last form in BODY is returned. + +Each element of VARLIST is either a string (which variable is +then removed from the environment), or a list (NAME +VALUEFORM) (which sets NAME to the value of VALUEFORM, a string). +All the VALUEFORMs are evaluated before any variables are set." + (declare (indent 2)) + (let ((old-env (make-symbol "old-env")) + (name (make-symbol "name")) + (value (make-symbol "value")) + (entry (make-symbol "entry")) + (frame (make-symbol "frame"))) + `(let ((,frame (selected-frame)) + ,old-env) + ;; Evaluate VALUEFORMs and replace them in VARLIST with their values. + (dolist (,entry ,varlist) + (unless (stringp ,entry) + (if (cdr (cdr ,entry)) + (error "`let-environment' bindings can have only one value-form")) + (setcdr ,entry (eval (cadr ,entry))))) + ;; Set the variables. + (dolist (,entry ,varlist) + (let ((,name (if (stringp ,entry) ,entry (car ,entry))) + (,value (if (consp ,entry) (cdr ,entry)))) + (setq ,old-env (cons (cons ,name (getenv ,name)) ,old-env)) + (setenv ,name ,value))) + (unwind-protect + (progn ,@body) + ;; Restore old values. + (with-selected-frame (if (frame-live-p ,frame) + ,frame + (selected-frame)) + (dolist (,entry ,old-env) + (setenv (car ,entry) (cdr ,entry)))))))) + (provide 'env) ;;; arch-tag: b7d6a8f7-bc81-46db-8e39-8d721d4ed0b8 diff --git a/lisp/faces.el b/lisp/faces.el index 320bf5d2b5d..43d95672446 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -932,7 +932,7 @@ an integer value." (let ((valid (case attribute (:family - (if window-system + (if (window-system frame) (mapcar #'(lambda (x) (cons (car x) (car x))) (x-font-family-list)) ;; Only one font on TTYs. @@ -941,7 +941,7 @@ an integer value." (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute))) ((:underline :overline :strike-through :box) - (if window-system + (if (window-system frame) (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)) (mapcar #'(lambda (c) (cons c c)) @@ -954,7 +954,7 @@ an integer value." ((:height) 'integerp) (:stipple - (and (memq window-system '(x w32 mac)) + (and (memq (window-system frame) '(x w32 mac)) (mapcar #'list (apply #'nconc (mapcar (lambda (dir) @@ -1072,7 +1072,7 @@ of a global face. Value is the new attribute value." ;; explicitly in VALID, using color approximation code ;; in tty-colors.el. (when (and (memq attribute '(:foreground :background)) - (not (memq window-system '(x w32 mac))) + (not (memq (window-system frame) '(x w32 mac))) (not (member new-value '("unspecified" "unspecified-fg" "unspecified-bg")))) @@ -1368,14 +1368,14 @@ If FRAME is nil, the current FRAME is used." req (car conjunct) options (cdr conjunct) match (cond ((eq req 'type) - (or (memq window-system options) + (or (memq (window-system frame) options) ;; FIXME: This should be revisited to use ;; display-graphic-p, provided that the ;; color selection depends on the number ;; of supported colors, and all defface's ;; are changed to look at number of colors ;; instead of (type graphic) etc. - (and (null window-system) + (and (null (window-system frame)) (memq 'tty options)) (and (memq 'motif options) (featurep 'motif)) @@ -1590,35 +1590,40 @@ variable with `setq'; this won't have the expected effect." (const light) (const :tag "automatic" nil))) -(defvar default-frame-background-mode nil - "Internal variable for the default brightness of the background. -Emacs sets it automatically depending on the terminal type. -The value `nil' means `dark'. If Emacs runs in non-windowed -mode from `xterm' or a similar terminal emulator, the value is -`light'. On rxvt terminals, the value depends on the environment -variable COLORFGBG.") (defun frame-set-background-mode (frame) "Set up display-dependent faces on FRAME. Display-dependent faces are those which have different definitions according to the `background-mode' and `display-type' frame parameters." (let* ((bg-resource - (and window-system + (and (window-system frame) (x-get-resource "backgroundMode" "BackgroundMode"))) (bg-color (frame-parameter frame 'background-color)) + (terminal-bg-mode (terminal-parameter frame 'background-mode)) + (tty-type (tty-type frame)) (bg-mode (cond (frame-background-mode) (bg-resource (intern (downcase bg-resource))) - ((and (null window-system) (null bg-color)) - ;; No way to determine this automatically (?). - (or default-frame-background-mode 'dark)) - ;; Unspecified frame background color can only happen - ;; on tty's. - ((member bg-color '(unspecified "unspecified-bg")) - (or default-frame-background-mode 'dark)) + (terminal-bg-mode) + ((and (null (window-system frame)) + ;; Unspecified frame background color can only + ;; happen on tty's. + (member bg-color '(nil unspecified "unspecified-bg"))) + ;; There is no way to determine the background mode + ;; automatically, so we make a guess based on the + ;; terminal type. + (if (and tty-type + (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" + tty-type)) + 'light + 'dark)) ((equal bg-color "unspecified-fg") ; inverted colors - (if (eq default-frame-background-mode 'light) 'dark 'light)) + (if (and tty-type + (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" + tty-type)) + 'dark + 'light)) ((>= (apply '+ (color-values bg-color frame)) ;; Just looking at the screen, colors whose ;; values add up to .6 of the white total @@ -1627,7 +1632,7 @@ according to the `background-mode' and `display-type' frame parameters." 'light) (t 'dark))) (display-type - (cond ((null window-system) + (cond ((null (window-system frame)) (if (tty-display-color-p frame) 'color 'mono)) ((display-color-p frame) 'color) @@ -1723,15 +1728,24 @@ the X resource ``reverseVideo'' is present, handle that. Value is the new frame created." (setq parameters (x-handle-named-frame-geometry parameters)) (let ((visibility-spec (assq 'visibility parameters)) - (frame-list (frame-list)) - (frame (x-create-frame (cons '(visibility . nil) parameters))) + (frame (x-create-frame `((visibility . nil) . ,parameters))) success) (unwind-protect (progn + (x-setup-function-keys frame) (x-handle-reverse-video frame parameters) (frame-set-background-mode frame) (face-set-after-frame-default frame) - (if (or (null frame-list) (null visibility-spec)) + ;; Arrange for the kill and yank functions to set and check the clipboard. + (modify-frame-parameters + frame '((interprogram-cut-function . x-select-text))) + (modify-frame-parameters + frame '((interprogram-paste-function . x-cut-buffer-or-selection-value))) + ;; Make sure the tool-bar is ready to be enabled. The + ;; `tool-bar-lines' frame parameter will not take effect + ;; without this call. + (tool-bar-setup frame) + (if (null visibility-spec) (make-frame-visible frame) (modify-frame-parameters frame (list visibility-spec))) (setq success t)) @@ -1790,7 +1804,7 @@ Initialize colors of certain faces from frame parameters." (condition-case () (progn (face-spec-set face (face-user-default-spec face) frame) - (if (memq window-system '(x w32 mac)) + (if (memq (window-system frame) '(x w32 mac)) (make-face-x-resource-internal face frame)) (internal-merge-in-global-face face frame)) (error nil))) @@ -1826,8 +1840,15 @@ created." (let ((frame (make-terminal-frame parameters)) success) (unwind-protect - (progn + (with-selected-frame frame (tty-handle-reverse-video frame (frame-parameters frame)) + + ;; Make sure the kill and yank functions do not touch the X clipboard. + (modify-frame-parameters frame '((interprogram-cut-function . nil))) + (modify-frame-parameters frame '((interprogram-paste-function . nil))) + + (set-locale-environment nil frame) + (tty-run-terminal-initialization frame) (frame-set-background-mode frame) (face-set-after-frame-default frame) (setq success t)) @@ -1835,6 +1856,52 @@ created." (delete-frame frame))) frame)) +(defun tty-find-type (pred type) + "Return the longest prefix of TYPE to which PRED returns non-nil. +TYPE should be a tty type name such as \"xterm-16color\". + +The function tries only those prefixes that are followed by a +dash or underscore in the original type name, like \"xterm\" in +the above example." + (let (hyphend) + (while (and type + (not (funcall pred type))) + ;; Strip off last hyphen and what follows, then try again + (setq type + (if (setq hyphend (string-match "[-_][^-_]+$" type)) + (substring type 0 hyphend) + nil)))) + type) + +(defun tty-run-terminal-initialization (frame &optional type) + "Run the special initialization code for the terminal type of FRAME. +The optional TYPE parameter may be used to override the autodetected +terminal type to a different value." + (setq type (or type (tty-type frame))) + ;; Load library for our terminal type. + ;; User init file can set term-file-prefix to nil to prevent this. + (with-selected-frame frame + (unless (or (null term-file-prefix) + ;; Don't reinitialize the terminal each time a new + ;; frame is opened on it. + (terminal-parameter frame 'terminal-initted)) + (let* (term-init-func) + ;; First, load the terminal initialization file, if it is + ;; available and it hasn't been loaded already. + (tty-find-type #'(lambda (type) + (let ((file (locate-library (concat term-file-prefix type)))) + (and file + (or (assoc file load-history) + (load file t t))))) + type) + ;; Next, try to find a matching initialization function, and call it. + (tty-find-type #'(lambda (type) + (fboundp (setq term-init-func + (intern (concat "terminal-init-" type))))) + type) + (when (fboundp term-init-func) + (funcall term-init-func)) + (set-terminal-parameter frame 'terminal-initted term-init-func))))) ;; Called from C function init_display to initialize faces of the ;; dumped terminal frame on startup. @@ -1842,7 +1909,11 @@ created." (defun tty-set-up-initial-frame-faces () (let ((frame (selected-frame))) (frame-set-background-mode frame) - (face-set-after-frame-default frame))) + (face-set-after-frame-default frame) + (set-frame-parameter frame-initial-frame 'term-environment-variable + (getenv "TERM")) + (set-frame-parameter frame-initial-frame 'display-environment-variable + (getenv "DISPLAY")))) diff --git a/lisp/files.el b/lisp/files.el index 9cc64284d15..33e9f9eb12c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2481,6 +2481,7 @@ asking you for confirmation." minor-mode-overriding-map-alist mode-line-buffer-identification mode-line-format + mode-line-client mode-line-modes mode-line-modified mode-line-mule-info @@ -5293,6 +5294,22 @@ With prefix arg, silently save all file-visiting buffers, then kill." (or (null confirm-kill-emacs) (funcall confirm-kill-emacs "Really exit Emacs? ")) (kill-emacs))) + +(defun save-buffers-kill-terminal (&optional arg) + "Offer to save each buffer, then kill the current connection. +If the current frame has no client, kill Emacs itself. + +With prefix arg, silently save all file-visiting buffers, then kill. + +If emacsclient was started with a list of filenames to edit, then +only these files will be asked to be saved." + (interactive "P") + (let ((proc (frame-parameter (selected-frame) 'client)) + (frame (selected-frame))) + (if (null proc) + (save-buffers-kill-emacs) + (server-save-buffers-kill-terminal proc arg)))) + ;; We use /: as a prefix to "quote" a file name ;; so that magic file name handlers will not apply to it. @@ -5390,7 +5407,7 @@ With prefix arg, silently save all file-visiting buffers, then kill." (define-key ctl-x-map "i" 'insert-file) (define-key esc-map "~" 'not-modified) (define-key ctl-x-map "\C-d" 'list-directory) -(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs) +(define-key ctl-x-map "\C-c" 'save-buffers-kill-terminal) (define-key ctl-x-map "\C-q" 'toggle-read-only) (define-key ctl-x-4-map "f" 'find-file-other-window) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 9ceca1b014f..1cefd8bb87d 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -2227,7 +2227,7 @@ other modes in which C preprocessor directives are used. e.g. `asm-mode' and `(;; Control structures. Emacs Lisp forms. (,(concat "(" (regexp-opt - '("cond" "if" "while" "while-no-input" "let" "let*" + '("cond" "if" "while" "while-no-input" "let" "let*" "let-environment" "prog" "progn" "progv" "prog1" "prog2" "prog*" "inline" "lambda" "save-restriction" "save-excursion" "save-window-excursion" "save-selected-window" @@ -2239,7 +2239,7 @@ other modes in which C preprocessor directives are used. e.g. `asm-mode' and "with-current-buffer" "with-electric-help" "with-local-quit" "with-no-warnings" "with-output-to-string" "with-output-to-temp-buffer" - "with-selected-window" "with-syntax-table" + "with-selected-window" "with-selected-frame" "with-syntax-table" "with-temp-buffer" "with-temp-file" "with-temp-message" "with-timeout" "with-timeout-handler") t) "\\>") diff --git a/lisp/frame.el b/lisp/frame.el index 863524d8add..cbb8de0571b 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -27,10 +27,28 @@ ;;; Code: -(defvar frame-creation-function nil - "Window-system dependent function to call to create a new frame. -The window system startup file should set this to its frame creation -function, which should take an alist of parameters as its argument.") +(defvar frame-creation-function-alist + (list (cons nil + (if (fboundp 'tty-create-frame-with-faces) + 'tty-create-frame-with-faces + (function + (lambda (parameters) + (error "Can't create multiple frames without a window system")))))) + "Alist of window-system dependent functions to call to create a new frame. +The window system startup file should add its frame creation +function to this list, which should take an alist of parameters +as its argument.") + +(defvar window-system-default-frame-alist nil + "Alist of window-system dependent default frame parameters. +You can set this in your `.emacs' file; for example, + + ;; Disable menubar and toolbar on the console, but enable them under X. + (setq window-system-default-frame-alist + '((x (menu-bar-lines . 1) (tool-bar-lines . 1)) + (nil (menu-bar-lines . 0) (tool-bar-lines . 0)))) + +Parameters specified here supersede the values given in `default-frame-alist'.") ;; The initial value given here used to ask for a minibuffer. ;; But that's not necessary, because the default is to have one. @@ -189,7 +207,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (defun frame-initialize () "Create an initial frame if necessary." ;; Are we actually running under a window system at all? - (if (and window-system (not noninteractive) (not (eq window-system 'pc))) + (if (and initial-window-system + (not noninteractive) + (not (eq initial-window-system 'pc))) (progn ;; Turn on special-display processing only if there's a window system. (setq special-display-function 'special-display-popup-frame) @@ -206,6 +226,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." (setq frame-initial-frame-alist (cons '(horizontal-scroll-bars . t) frame-initial-frame-alist))) + (setq frame-initial-frame-alist + (cons (cons 'window-system initial-window-system) + frame-initial-frame-alist)) (setq default-minibuffer-frame (setq frame-initial-frame (make-frame frame-initial-frame-alist))) @@ -215,20 +238,17 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." ;; because that would override explicit user resizing. (setq initial-frame-alist (frame-remove-geometry-params initial-frame-alist)))) + ;; Copy the environment of the Emacs process into the new frame. + (set-frame-parameter frame-initial-frame 'environment + (frame-parameter terminal-frame 'environment)) + (set-frame-parameter frame-initial-frame 'term-environment-variable + (getenv "TERM")) + (set-frame-parameter frame-initial-frame 'display-environment-variable + (getenv "DISPLAY")) ;; At this point, we know that we have a frame open, so we ;; can delete the terminal frame. (delete-frame terminal-frame) - (setq terminal-frame nil)) - - ;; No, we're not running a window system. Use make-terminal-frame if - ;; we support that feature, otherwise arrange to cause errors. - (or (eq window-system 'pc) - (setq frame-creation-function - (if (fboundp 'tty-create-frame-with-faces) - 'tty-create-frame-with-faces - (lambda (parameters) - (error - "Can't create multiple frames without a window system"))))))) + (setq terminal-frame nil)))) (defvar frame-notice-user-settings t "Non-nil means function `frame-notice-user-settings' wasn't run yet.") @@ -238,7 +258,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args." ;; information to which we must react; do what needs to be done. (defun frame-notice-user-settings () "Act on user's init file settings of frame parameters. -React to settings of `default-frame-alist', `initial-frame-alist' there." +React to settings of `initial-frame-alist', +`window-system-default-frame-alist' and `default-frame-alist' +there (in decreasing order of priority)." ;; Make menu-bar-mode and default-frame-alist consistent. (when (boundp 'menu-bar-mode) (let ((default (assq 'menu-bar-lines default-frame-alist))) @@ -253,20 +275,30 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; parameter in default-frame-alist in a dumped Emacs, which is not ;; what we want. (when (and (boundp 'tool-bar-mode) - (not noninteractive)) + (not noninteractive)) (let ((default (assq 'tool-bar-lines default-frame-alist))) (if default - (setq tool-bar-mode (not (eq (cdr default) 0))) - (setq default-frame-alist - (cons (cons 'tool-bar-lines (if tool-bar-mode 1 0)) - default-frame-alist))))) + (setq tool-bar-mode (not (eq (cdr default) 0))) + ;; If Emacs was started on a tty, changing default-frame-alist + ;; would disable the toolbar on X frames created later. We + ;; want to keep the default of showing a toolbar under X even + ;; in this case. + ;; + ;; If the user explicitly called `tool-bar-mode' in .emacs, + ;; then default-frame-alist is already changed anyway. + (when initial-window-system + (setq default-frame-alist + (cons (cons 'tool-bar-lines (if tool-bar-mode 1 0)) + default-frame-alist)))))) ;; Creating and deleting frames may shift the selected frame around, ;; and thus the current buffer. Protect against that. We don't ;; want to use save-excursion here, because that may also try to set ;; the buffer of the selected window, which fails when the selected ;; window is the minibuffer. - (let ((old-buffer (current-buffer))) + (let ((old-buffer (current-buffer)) + (window-system-frame-alist (cdr (assq initial-window-system + window-system-default-frame-alist)))) (when (and frame-notice-user-settings (null frame-initial-frame)) @@ -278,8 +310,9 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; Can't modify the minibuffer parameter, so don't try. (setq parms (delq (assq 'minibuffer parms) parms)) (modify-frame-parameters nil - (if (null window-system) + (if (null initial-window-system) (append initial-frame-alist + window-system-frame-alist default-frame-alist parms nil) @@ -287,7 +320,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; default-frame-alist were already ;; applied in pc-win.el. parms)) - (if (null window-system) ;; MS-DOS does this differently in pc-win.el + (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el (let ((newparms (frame-parameters)) (frame (selected-frame))) (tty-handle-reverse-video frame newparms) @@ -309,6 +342,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; switch `tool-bar-mode' off. (when (display-graphic-p) (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) + (assq 'tool-bar-lines window-system-frame-alist) (assq 'tool-bar-lines default-frame-alist)))) (when (and tool-bar-originally-present (or (null tool-bar-lines) @@ -369,6 +403,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; create here, so that its new value, gleaned from the user's ;; .emacs file, will be applied to the existing screen. (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist) + (assq 'minibuffer window-system-frame-alist) (assq 'minibuffer default-frame-alist) '(minibuffer . t))) t)) @@ -388,6 +423,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." (setq parms (delq (assq 'name parms) parms))) (setq parms (append initial-frame-alist + window-system-frame-alist default-frame-alist parms nil)) @@ -463,6 +499,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;; the new parameters. (let (newparms allparms tail) (setq allparms (append initial-frame-alist + window-system-frame-alist default-frame-alist nil)) (if (assq 'height frame-initial-geometry-arguments) (setq allparms (assq-delete-all 'height allparms))) @@ -519,19 +556,25 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." (defun modify-all-frames-parameters (alist) "Modify all current and future frames' parameters according to ALIST. This changes `default-frame-alist' and possibly `initial-frame-alist'. +Furthermore, this function removes all parameters in ALIST from +`window-system-default-frame-alist'. See help of `modify-frame-parameters' for more information." - (let (element) ;; temp - (dolist (frame (frame-list)) - (modify-frame-parameters frame alist)) - - (dolist (pair alist) ;; conses to add/replace - ;; initial-frame-alist needs setting only when - ;; frame-notice-user-settings is true - (and frame-notice-user-settings - (setq element (assoc (car pair) initial-frame-alist)) - (setq initial-frame-alist (delq element initial-frame-alist))) - (and (setq element (assoc (car pair) default-frame-alist)) - (setq default-frame-alist (delq element default-frame-alist))))) + (dolist (frame (frame-list)) + (modify-frame-parameters frame alist)) + + (dolist (pair alist) ;; conses to add/replace + ;; initial-frame-alist needs setting only when + ;; frame-notice-user-settings is true. + (and frame-notice-user-settings + (setq initial-frame-alist + (assq-delete-all (car pair) initial-frame-alist))) + (setq default-frame-alist + (assq-delete-all (car pair) default-frame-alist)) + ;; Remove any similar settings from the window-system specific + ;; parameters---they would override default-frame-alist. + (dolist (w window-system-default-frame-alist) + (setcdr w (assq-delete-all (car pair) (cdr w))))) + (and frame-notice-user-settings (setq initial-frame-alist (append initial-frame-alist alist))) (setq default-frame-alist (append default-frame-alist alist))) @@ -562,12 +605,28 @@ is not considered (see `next-frame')." (select-frame-set-input-focus (selected-frame))) (defun make-frame-on-display (display &optional parameters) - "Make a frame on display DISPLAY. + "Make a frame on X display DISPLAY. The optional second argument PARAMETERS specifies additional frame parameters." (interactive "sMake frame on display: ") (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display) (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) - (make-frame (cons (cons 'display display) parameters))) + (when (and (boundp 'x-initialized) (not x-initialized)) + (setq x-display-name display) + (x-initialize-window-system)) + (make-frame `((window-system . x) (display . ,display) . ,parameters))) + +(defun make-frame-on-tty (tty type &optional parameters) + "Make a frame on terminal device TTY. +TTY should be the file name of the tty device to use. TYPE +should be the terminal type string of TTY, for example \"xterm\" +or \"vt100\". The optional third argument PARAMETERS specifies +additional frame parameters." + (interactive "fOpen frame on tty device: \nsTerminal type of %s: ") + (unless tty + (error "Invalid terminal device")) + (unless type + (error "Invalid terminal type")) + (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) . ,parameters))) (defun close-display-connection (display) "Close the connection to a display, deleting all its associated frames. @@ -636,7 +695,12 @@ You cannot specify either `width' or `height', you must use neither or both. (minibuffer . only) The frame should contain only a minibuffer. (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window. -Before the frame is created (via `frame-creation-function'), functions on the + (window-system . nil) The frame should be displayed on a terminal device. + (window-system . x) The frame should be displayed in an X window. + + (terminal . ID) The frame should use the terminal identified by ID. + +Before the frame is created (via `frame-creation-function-alist'), functions on the hook `before-make-frame-hook' are run. After the frame is created, functions on `after-make-frame-functions' are run with one arg, the newly created frame. @@ -646,8 +710,39 @@ window system may select the new frame for its own reasons, for instance if the frame appears under the mouse pointer and your setup is for focus to follow the pointer." (interactive) - (run-hooks 'before-make-frame-hook) - (let ((frame (funcall frame-creation-function parameters))) + (let* ((w (cond + ((assq 'terminal parameters) + (let ((type (terminal-live-p (cdr (assq 'terminal parameters))))) + (cond + ((eq type t) nil) + ((eq type nil) (error "Terminal %s does not exist" (cdr (assq 'terminal parameters)))) + (t type)))) + ((assq 'window-system parameters) + (cdr (assq 'window-system parameters))) + (t window-system))) + (frame-creation-function (cdr (assq w frame-creation-function-alist))) + (oldframe (selected-frame)) + frame) + (unless frame-creation-function + (error "Don't know how to create a frame on window system %s" w)) + (run-hooks 'before-make-frame-hook) + (setq frame (funcall frame-creation-function (append parameters (cdr (assq w window-system-default-frame-alist))))) + (normal-erase-is-backspace-setup-frame frame) + ;; Inherit the 'environment and 'client parameters. + (let ((env (frame-parameter oldframe 'environment)) + (client (frame-parameter oldframe 'client)) + (termenv (frame-parameter oldframe 'term-environment-variable)) + (displayenv (frame-parameter oldframe 'display-environment-variable))) + (if (not (framep env)) + (setq env oldframe)) + (if (and env (not (assq 'environment parameters))) + (set-frame-parameter frame 'environment env)) + (if (and termenv (not (assq 'term-environment-variable parameters))) + (set-frame-parameter frame 'term-environment-variable termenv)) + (if (and displayenv (not (assq 'display-environment-variable parameters))) + (set-frame-parameter frame 'display-environment-variable displayenv)) + (if (and client (not (assq 'client parameters))) + (set-frame-parameter frame 'client client))) (run-hook-with-args 'after-make-frame-functions frame) frame)) @@ -667,23 +762,29 @@ setup is for focus to follow the pointer." (lambda (frame) (eq frame (window-frame (minibuffer-window frame)))))) -(defun frames-on-display-list (&optional display) - "Return a list of all frames on DISPLAY. -DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN. -If DISPLAY is omitted or nil, it defaults to the selected frame's display." - (let* ((display (or display (frame-parameter nil 'display))) +(defun frames-on-display-list (&optional terminal) + "Return a list of all frames on TERMINAL. + +TERMINAL should be a terminal identifier (an integer), a frame, +or a name of an X display (a string of the form +HOST:SERVER.SCREEN). + +If TERMINAL is omitted or nil, it defaults to the selected +frame's terminal device." + (let* ((terminal (terminal-id terminal)) (func #'(lambda (frame) - (equal (frame-parameter frame 'display) display)))) + (eq (frame-terminal frame) terminal)))) (filtered-frame-list func))) -(defun framep-on-display (&optional display) - "Return the type of frames on DISPLAY. -DISPLAY may be a display name or a frame. If it is a frame, its type is -returned. -If DISPLAY is omitted or nil, it defaults to the selected frame's display. -All frames on a given display are of the same type." - (or (framep display) - (framep (car (frames-on-display-list display))))) +(defun framep-on-display (&optional terminal) + "Return the type of frames on TERMINAL. +TERMINAL may be a terminal id, a display name or a frame. If it +is a frame, its type is returned. If TERMINAL is omitted or nil, +it defaults to the selected frame's terminal device. All frames +on a given display are of the same type." + (or (terminal-live-p terminal) + (framep terminal) + (framep (car (frames-on-display-list terminal))))) (defun frame-remove-geometry-params (param-list) "Return the parameter list PARAM-LIST, but with geometry specs removed. @@ -722,9 +823,9 @@ This variable does not have any effect on MS-Windows." (select-frame frame) (raise-frame frame) ;; Ensure, if possible, that frame gets input focus. - (cond ((memq window-system '(x mac)) + (cond ((memq (window-system frame) '(x max)) (x-focus-frame frame)) - ((eq window-system 'w32) + ((eq (window-system frame) 'w32) (w32-focus-frame frame))) (cond (focus-follows-mouse (set-mouse-position (selected-frame) (1- (frame-width)) 0)))) @@ -761,6 +862,21 @@ Otherwise, that variable should be nil." (iconify-frame) (make-frame-visible))) +(defun suspend-frame () + "Do whatever is right to suspend the current frame. +Calls `suspend-emacs' if invoked from the controlling tty device, +`suspend-tty' from a secondary tty device, and +`iconify-or-deiconify-frame' from an X frame." + (interactive) + (let ((type (framep (selected-frame)))) + (cond + ((eq type 'x) (iconify-or-deiconify-frame)) + ((eq type t) + (if (controlling-tty-p) + (suspend-emacs) + (suspend-tty))) + (t (suspend-emacs))))) + (defun make-frame-names-alist () (let* ((current-frame (selected-frame)) (falist @@ -794,9 +910,9 @@ If there is no frame by that name, signal an error." (raise-frame frame) (select-frame frame) ;; Ensure, if possible, that frame gets input focus. - (cond ((memq window-system '(x mac)) + (cond ((eq (window-system frame) 'x) (x-focus-frame frame)) - ((eq window-system 'w32) + ((eq (window-system frame) 'w32) (w32-focus-frame frame))) (when focus-follows-mouse (set-mouse-position frame (1- (frame-width frame)) 0)))) @@ -1006,6 +1122,10 @@ bars (top, bottom, or nil)." (cons vert hor))) ;;;; Frame/display capabilities. +(defun selected-terminal () + "Return the terminal that is now selected." + (frame-terminal (selected-frame))) + (defun display-mouse-p (&optional display) "Return non-nil if DISPLAY has a mouse available. DISPLAY can be a display name, a frame, or nil (meaning the selected @@ -1183,7 +1303,7 @@ the question is inapplicable to a certain kind of display." ((eq frame-type 'pc) 16) (t - (tty-display-color-cells))))) + (tty-display-color-cells display))))) (defun display-visual-class (&optional display) "Returns the visual class of DISPLAY. diff --git a/lisp/fringe.el b/lisp/fringe.el index 3160d960ffd..7ea3e8a2b5d 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -104,40 +104,13 @@ This is usually invoked when setting `fringe-mode' via customize." See `fringe-mode' for possible values and their effect." (setq fringe-mode value) - ;; Apply it to default-frame-alist. - (let ((parameter (assq 'left-fringe default-frame-alist))) - (if (consp parameter) - (setcdr parameter (if (consp fringe-mode) - (car fringe-mode) - fringe-mode)) - (setq default-frame-alist - (cons (cons 'left-fringe (if (consp fringe-mode) - (car fringe-mode) - fringe-mode)) - default-frame-alist)))) - (let ((parameter (assq 'right-fringe default-frame-alist))) - (if (consp parameter) - (setcdr parameter (if (consp fringe-mode) - (cdr fringe-mode) - fringe-mode)) - (setq default-frame-alist - (cons (cons 'right-fringe (if (consp fringe-mode) - (cdr fringe-mode) - fringe-mode)) - default-frame-alist)))) - - ;; Apply it to existing frames. - (let ((frames (frame-list))) - (while frames - (modify-frame-parameters - (car frames) - (list (cons 'left-fringe (if (consp fringe-mode) - (car fringe-mode) - fringe-mode)) - (cons 'right-fringe (if (consp fringe-mode) - (cdr fringe-mode) - fringe-mode)))) - (setq frames (cdr frames))))) + (modify-all-frames-parameters + (list (cons 'left-fringe (if (consp fringe-mode) + (car fringe-mode) + fringe-mode)) + (cons 'right-fringe (if (consp fringe-mode) + (cdr fringe-mode) + fringe-mode))))) ;; For initialization of fringe-mode, take account of changes ;; made explicitly to default-frame-alist. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 04b359865d4..1de255d1e63 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -446,10 +446,11 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." 0)) ;;;###autoload -(defun describe-variable (variable &optional buffer) +(defun describe-variable (variable &optional buffer frame) "Display the full documentation of VARIABLE (a symbol). Returns the documentation as a string, also. -If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), +If VARIABLE has a buffer-local value in BUFFER or FRAME +\(default to the current buffer and current frame), it is displayed along with the global value." (interactive (let ((v (variable-at-point)) @@ -468,14 +469,19 @@ it is displayed along with the global value." (list (if (equal val "") v (intern val))))) (unless (buffer-live-p buffer) (setq buffer (current-buffer))) + (unless (frame-live-p frame) (setq frame (selected-frame))) (if (not (symbolp variable)) (message "You did not specify a variable") (save-excursion - (let* ((valvoid (not (with-current-buffer buffer (boundp variable)))) - ;; Extract the value before setting up the output buffer, - ;; in case `buffer' *is* the output buffer. - (val (unless valvoid (buffer-local-value variable buffer))) - val-start-pos) + (let ((valvoid (not (with-current-buffer buffer (boundp variable)))) + val val-start-pos locus) + ;; Extract the value before setting up the output buffer, + ;; in case `buffer' *is* the output buffer. + (unless valvoid + (with-selected-frame frame + (with-current-buffer buffer + (setq val (symbol-value variable) + locus (variable-binding-locus variable))))) (help-setup-xref (list #'describe-variable variable buffer) (interactive-p)) (with-output-to-temp-buffer (help-buffer) @@ -537,11 +543,13 @@ it is displayed along with the global value." (delete-region (1- from) from))))) (terpri) - (when (local-variable-p variable) - (princ (format "%socal in buffer %s; " - (if (get variable 'permanent-local) - "Permanently l" "L") - (buffer-name))) + (when locus + (if (bufferp locus) + (princ (format "%socal in buffer %s; " + (if (get variable 'permanent-local) + "Permanently l" "L") + (buffer-name))) + (princ (format "It is a frame-local variable; "))) (if (not (default-boundp variable)) (princ "globally void") (let ((val (default-value variable))) diff --git a/lisp/international/encoded-kb.el b/lisp/international/encoded-kb.el index 7b3e6746b4a..392951d1c0d 100644 --- a/lisp/international/encoded-kb.el +++ b/lisp/international/encoded-kb.el @@ -175,7 +175,7 @@ The following key sequence may cause multilingual text insertion." (setq str (format "%s%c" str (read-char-exclusive)))) (vector (aref result 0)))) -(defun encoded-kbd-setup-keymap (coding) +(defun encoded-kbd-setup-keymap (keymap coding) ;; At first, reset the keymap. (define-key encoded-kbd-mode-map "\e" nil) ;; Then setup the keymap according to the keyboard coding system. @@ -183,7 +183,7 @@ The following key sequence may cause multilingual text insertion." ((eq (coding-system-type coding) 1) ; SJIS (let ((i 128)) (while (< i 256) - (define-key key-translation-map + (define-key keymap (vector i) 'encoded-kbd-self-insert-sjis) (setq i (1+ i)))) 8) @@ -191,7 +191,7 @@ The following key sequence may cause multilingual text insertion." ((eq (coding-system-type coding) 3) ; Big5 (let ((i 161)) (while (< i 255) - (define-key key-translation-map + (define-key keymap (vector i) 'encoded-kbd-self-insert-big5) (setq i (1+ i)))) 8) @@ -217,20 +217,20 @@ The following key sequence may cause multilingual text insertion." (aset encoded-kbd-iso2022-invocations 1 1)) (when use-designation (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) - (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) + (define-key keymap "\e" 'encoded-kbd-iso2022-esc-prefix)) (when (or (aref flags 2) (aref flags 3)) - (define-key key-translation-map + (define-key keymap [?\216] 'encoded-kbd-iso2022-single-shift) - (define-key key-translation-map + (define-key keymap [?\217] 'encoded-kbd-iso2022-single-shift)) (or (eq (aref flags 0) 'ascii) (dotimes (i 96) - (define-key key-translation-map + (define-key keymap (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) (if (aref flags 7) t (dotimes (i 96) - (define-key key-translation-map + (define-key keymap (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) 8)))) @@ -245,7 +245,7 @@ The following key sequence may cause multilingual text insertion." (setq from (setq to elt))) (while (<= from to) (if (>= from 128) - (define-key key-translation-map + (define-key keymap (vector from) 'encoded-kbd-self-insert-ccl)) (setq from (1+ from)))) 8)) @@ -253,59 +253,47 @@ The following key sequence may cause multilingual text insertion." (t nil))) -;; key-translation-map at the time Encoded-kbd mode is turned on is -;; saved here. -(defvar saved-key-translation-map nil) - -;; Input mode at the time Encoded-kbd mode is turned on is saved here. -(defvar saved-input-mode nil) - -(put 'encoded-kbd-mode 'permanent-local t) ;;;###autoload -(define-minor-mode encoded-kbd-mode - "Toggle Encoded-kbd minor mode. -With arg, turn Encoded-kbd mode on if and only if arg is positive. - -You should not turn this mode on manually, instead use the command -\\[set-keyboard-coding-system] which turns on or off this mode -automatically. - -In Encoded-kbd mode, a text sent from keyboard is accepted -as a multilingual text encoded in a coding system set by -\\[set-keyboard-coding-system]." - :global t :group 'keyboard :group 'mule - - (if encoded-kbd-mode - ;; We are turning on Encoded-kbd mode. - (let ((coding (keyboard-coding-system)) - result) - (or saved-key-translation-map - (if (keymapp key-translation-map) - (setq saved-key-translation-map - (copy-keymap key-translation-map)) - (setq key-translation-map (make-sparse-keymap)))) - (or saved-input-mode - (setq saved-input-mode - (current-input-mode))) - (setq result (and coding (encoded-kbd-setup-keymap coding))) - (if result - (if (eq result 8) - (set-input-mode - (nth 0 saved-input-mode) - (nth 1 saved-input-mode) - 'use-8th-bit - (nth 3 saved-input-mode))) - (setq encoded-kbd-mode nil - saved-key-translation-map nil - saved-input-mode nil) - (error "Unsupported coding system in Encoded-kbd mode: %S" - coding))) - - ;; We are turning off Encoded-kbd mode. - (setq key-translation-map saved-key-translation-map - saved-key-translation-map nil) - (apply 'set-input-mode saved-input-mode) - (setq saved-input-mode nil))) +(defun encoded-kbd-setup-display (display) + "Set up a `key-translation-map' for `keyboard-coding-system' on DISPLAY. + +DISPLAY may be a display id, a frame, or nil for the selected frame's display." + (let ((frame (if (framep display) display (car (frames-on-display-list display))))) + (when frame + (with-selected-frame frame + ;; Remove any previous encoded-kb keymap from key-translation-map. + (let ((m local-key-translation-map)) + (if (equal (keymap-prompt m) "encoded-kb") + (setq local-key-translation-map (keymap-parent m)) + (while (keymap-parent m) + (if (equal (keymap-prompt (keymap-parent m)) "encoded-kb") + (set-keymap-parent m (keymap-parent (keymap-parent m)))) + (setq m (keymap-parent m))))) + + (if (keyboard-coding-system) + ;; We are turning on Encoded-kbd mode. + (let ((coding (keyboard-coding-system)) + (keymap (make-sparse-keymap "encoded-kb")) + (cim (current-input-mode)) + result) + (set-keymap-parent keymap local-key-translation-map) + (setq local-key-translation-map keymap) + (unless (terminal-parameter nil 'encoded-kbd-saved-input-meta-mode) + (set-terminal-parameter nil 'encoded-kbd-saved-input-mode (nth 2 cim))) + (setq result (and coding (encoded-kbd-setup-keymap keymap coding))) + (if result + (when (and (eq result 8) + (memq (nth 2 cim) '(t nil))) + (set-input-meta-mode 'use-8th-bit)) + (set-terminal-parameter nil 'encoded-kbd-saved-input-meta-mode nil) + (error "Unsupported coding system in Encoded-kbd mode: %S" + coding))) + ;; We are turning off Encoded-kbd mode. + (when (and (terminal-parameter nil 'encoded-kbd-saved-input-meta-mode) + (not (equal (nth 2 (current-input-mode)) + (terminal-parameter nil 'encoded-kbd-saved-input-meta-mode)))) + (set-input-meta-mode (terminal-parameter nil 'encoded-kbd-saved-input-meta-mode))) + (set-terminal-parameter nil 'saved-input-meta-mode nil)))))) (provide 'encoded-kb) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 9501d5f7cc0..5bbe53e7ea7 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -148,7 +148,7 @@ t) (define-key-after set-coding-system-map [set-terminal-coding-system] '(menu-item "For Terminal" set-terminal-coding-system - :enable (null (memq window-system '(x w32 mac))) + :enable (null (memq initial-window-system '(x w32 mac))) :help "How to encode terminal output") t) (define-key-after set-coding-system-map [separator-3] @@ -1830,7 +1830,7 @@ The default status is as follows: (reset-language-environment) -(defun set-display-table-and-terminal-coding-system (language-name &optional coding-system) +(defun set-display-table-and-terminal-coding-system (language-name &optional coding-system display) "Set up the display table and terminal coding system for LANGUAGE-NAME." (let ((coding (get-language-info language-name 'unibyte-display))) (if (and coding @@ -1846,7 +1846,7 @@ The default status is as follows: (dotimes (i 128) (aset standard-display-table (+ i 128) nil)))) (or (eq window-system 'pc) - (set-terminal-coding-system (or coding-system coding))))) + (set-terminal-coding-system (or coding-system coding) display)))) (defun set-language-environment (language-name) "Set up multi-lingual environment for using LANGUAGE-NAME. @@ -2454,7 +2454,7 @@ is returned. Thus, for instance, if charset \"ISO8859-2\", ;; too, for setting things such as calendar holidays, ps-print paper ;; size, spelling dictionary. -(defun set-locale-environment (&optional locale-name) +(defun set-locale-environment (&optional locale-name frame) "Set up multi-lingual environment for using LOCALE-NAME. This sets the language environment, the coding system priority, the default input method and sometimes other things. @@ -2475,6 +2475,10 @@ directory named `/usr/share/locale' or `/usr/lib/locale'. LOCALE-NAME will be translated according to the table specified by `locale-translation-file-name'. +If FRAME is non-nil, only set the keyboard coding system and the +terminal coding system for the terminal of that frame, and don't +touch session-global parameters like the language environment. + See also `locale-charset-language-names', `locale-language-names', `locale-preferred-coding-systems' and `locale-coding-system'." (interactive "sSet environment for locale: ") @@ -2504,7 +2508,7 @@ See also `locale-charset-language-names', `locale-language-names', (let ((vars '("LC_ALL" "LC_CTYPE" "LANG"))) (while (and vars (= 0 (length locale))) ; nil or empty string - (setq locale (getenv (pop vars)))))) + (setq locale (getenv (pop vars) frame))))) (unless locale ;; The two tests are kept separate so the byte-compiler sees @@ -2578,28 +2582,34 @@ See also `locale-charset-language-names', `locale-language-names', ;; Set up for this character set. This is now the right way ;; to do it for both unibyte and multibyte modes. - (set-language-environment language-name) + (unless frame + (set-language-environment language-name)) ;; If default-enable-multibyte-characters is nil, ;; we are using single-byte characters, ;; so the display table and terminal coding system are irrelevant. (when default-enable-multibyte-characters (set-display-table-and-terminal-coding-system - language-name coding-system)) + language-name coding-system frame)) ;; Set the `keyboard-coding-system' if appropriate (tty ;; only). At least X and MS Windows can generate ;; multilingual input. - (unless window-system - (let ((kcs (or coding-system - (car (get-language-info language-name - 'coding-system))))) - (if kcs (set-keyboard-coding-system kcs)))) - - (setq locale-coding-system - (car (get-language-info language-name 'coding-priority)))) - - (when (and coding-system + ;; XXX This was disabled unless `window-system', but that + ;; leads to buggy behaviour when a tty frame is opened + ;; later. Setting the keyboard coding system has no adverse + ;; effect on X, so let's do it anyway. -- Lorentey + (let ((kcs (or coding-system + (car (get-language-info language-name + 'coding-system))))) + (if kcs (set-keyboard-coding-system kcs frame))) + + (unless frame + (setq locale-coding-system + (car (get-language-info language-name 'coding-priority))))) + + (when (and (not frame) + coding-system (not (coding-system-equal coding-system locale-coding-system))) (prefer-coding-system coding-system) @@ -2614,9 +2624,9 @@ See also `locale-charset-language-names', `locale-language-names', (when (boundp 'w32-ansi-code-page) (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page)))) (when (coding-system-p code-page-coding) - (setq locale-coding-system code-page-coding) - (set-keyboard-coding-system code-page-coding) - (set-terminal-coding-system code-page-coding)))) + (unless frame (setq locale-coding-system code-page-coding)) + (set-keyboard-coding-system code-page-coding frame) + (set-terminal-coding-system code-page-coding frame)))) (when (eq system-type 'darwin) ;; On Darwin, file names are always encoded in utf-8, no matter @@ -2625,38 +2635,39 @@ See also `locale-charset-language-names', `locale-language-names', ;; Mac OS X's Terminal.app by default uses utf-8 regardless of ;; the locale. (when (and (null window-system) - (equal (getenv "TERM_PROGRAM") "Apple_Terminal")) + (equal (getenv "TERM_PROGRAM" frame) "Apple_Terminal")) (set-terminal-coding-system 'utf-8) (set-keyboard-coding-system 'utf-8))) ;; Default to A4 paper if we're not in a C, POSIX or US locale. ;; (See comments in Flocale_info.) - (let ((locale locale) - (paper (locale-info 'paper))) - (if paper - ;; This will always be null at the time of writing. - (cond - ((equal paper '(216 279)) - (setq ps-paper-type 'letter)) - ((equal paper '(210 297)) - (setq ps-paper-type 'a4))) - (let ((vars '("LC_ALL" "LC_PAPER" "LANG"))) - (while (and vars (= 0 (length locale))) - (setq locale (getenv (pop vars))))) - (when locale - ;; As of glibc 2.2.5, these are the only US Letter locales, - ;; and the rest are A4. - (setq ps-paper-type - (or (locale-name-match locale '(("c$" . letter) - ("posix$" . letter) - (".._us" . letter) - (".._pr" . letter) - (".._ca" . letter) - ("enu$" . letter) ; Windows - ("esu$" . letter) - ("enc$" . letter) - ("frc$" . letter))) - 'a4)))))) + (unless frame + (let ((locale locale) + (paper (locale-info 'paper))) + (if paper + ;; This will always be null at the time of writing. + (cond + ((equal paper '(216 279)) + (setq ps-paper-type 'letter)) + ((equal paper '(210 297)) + (setq ps-paper-type 'a4))) + (let ((vars '("LC_ALL" "LC_PAPER" "LANG"))) + (while (and vars (= 0 (length locale))) + (setq locale (getenv (pop vars) frame)))) + (when locale + ;; As of glibc 2.2.5, these are the only US Letter locales, + ;; and the rest are A4. + (setq ps-paper-type + (or (locale-name-match locale '(("c$" . letter) + ("posix$" . letter) + (".._us" . letter) + (".._pr" . letter) + (".._ca" . letter) + ("enu$" . letter) ; Windows + ("esu$" . letter) + ("enc$" . letter) + ("frc$" . letter))) + 'a4))))))) nil) ;;; Charset property diff --git a/lisp/international/mule.el b/lisp/international/mule.el index a7b97b16d20..e1285aba875 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1233,13 +1233,17 @@ see) to CODING-SYSTEM." This is normally set according to the selected language environment. See also the command `set-terminal-coding-system'.") -(defun set-terminal-coding-system (coding-system) - "Set coding system of your terminal to CODING-SYSTEM. -All text output to the terminal will be encoded +(defun set-terminal-coding-system (coding-system &optional display) + "Set coding system of terminal output to CODING-SYSTEM. +All text output to DISPLAY will be encoded with the specified coding system. + For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]. The default is determined by the selected language environment -or by the previous use of this command." +or by the previous use of this command. + +DISPLAY may be a display id, a frame, or nil for the selected frame's display. +The setting has no effect on graphical displays." (interactive (list (let ((default (if (and (not (terminal-coding-system)) default-terminal-coding-system) @@ -1253,7 +1257,7 @@ or by the previous use of this command." (setq coding-system default-terminal-coding-system)) (if coding-system (setq default-terminal-coding-system coding-system)) - (set-terminal-coding-system-internal coding-system) + (set-terminal-coding-system-internal coding-system display) (redraw-frame (selected-frame))) (defvar default-keyboard-coding-system nil @@ -1261,14 +1265,17 @@ or by the previous use of this command." This is normally set according to the selected language environment. See also the command `set-keyboard-coding-system'.") -(defun set-keyboard-coding-system (coding-system) - "Set coding system for keyboard input to CODING-SYSTEM. -In addition, this command enables Encoded-kbd minor mode. -\(If CODING-SYSTEM is nil, Encoded-kbd mode is turned off -- see -`encoded-kbd-mode'.) +(defun set-keyboard-coding-system (coding-system &optional display) + "Set coding system for keyboard input on DISPLAY to CODING-SYSTEM. +In addition, this command calls `encoded-kbd-setup-display' to set up the +translation of keyboard input events to the specified coding system. + For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]. The default is determined by the selected language environment -or by the previous use of this command." +or by the previous use of this command. + +DISPLAY may be a display id, a frame, or nil for the selected frame's display. +The setting has no effect on graphical displays." (interactive (list (let ((default (if (and (not (keyboard-coding-system)) default-keyboard-coding-system) @@ -1285,9 +1292,9 @@ or by the previous use of this command." (if (and coding-system (coding-system-get coding-system 'ascii-incompatible)) (error "%s is not ASCII-compatible" coding-system)) - (set-keyboard-coding-system-internal coding-system) + (set-keyboard-coding-system-internal coding-system display) (setq keyboard-coding-system coding-system) - (encoded-kbd-mode (if coding-system 1 0))) + (encoded-kbd-setup-display display)) (defcustom keyboard-coding-system nil "Specify coding system for keyboard input. @@ -1303,8 +1310,8 @@ use either \\[customize] or \\[set-keyboard-coding-system]." :link '(info-link "(emacs)Terminal Coding") :link '(info-link "(emacs)Unibyte Mode") :set (lambda (symbol value) - ;; Don't load encoded-kbd-mode unnecessarily. - (if (or value (boundp 'encoded-kbd-mode)) + ;; Don't load encoded-kb unnecessarily. + (if (or value (boundp 'encoded-kbd-setup-display)) (set-keyboard-coding-system value) (set-default 'keyboard-coding-system nil))) ; must initialize :version "22.1" diff --git a/lisp/isearch.el b/lisp/isearch.el index 9b9db880890..93d43fcf18b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1667,7 +1667,7 @@ Isearch mode." (keylist (listify-key-sequence key)) scroll-command isearch-point) (cond ((and (= (length key) 1) - (let ((lookup (lookup-key function-key-map key))) + (let ((lookup (lookup-key local-function-key-map key))) (not (or (null lookup) (integerp lookup) (keymapp lookup))))) ;; Handle a function key that translates into something else. @@ -1681,7 +1681,7 @@ Isearch mode." (isearch-done) (apply 'isearch-unread keylist)) (setq keylist - (listify-key-sequence (lookup-key function-key-map key))) + (listify-key-sequence (lookup-key local-function-key-map key))) (while keylist (setq key (car keylist)) ;; If KEY is a printing char, we handle it here diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 25df6135e3e..98a856a2987 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4,7 +4,7 @@ ;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best ;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5" -;;;;;; "play/5x5.el" (17941 38806)) +;;;;;; "play/5x5.el" (17994 6715)) ;;; Generated autoloads from play/5x5.el (autoload (quote 5x5) "5x5" "\ @@ -63,14 +63,14 @@ should return a grid vector array that is the new solution. ;;;*** -;;;### (autoloads nil "abbrev" "abbrev.el" (17905 55681)) +;;;### (autoloads nil "abbrev" "abbrev.el" (17994 6715)) ;;; Generated autoloads from abbrev.el (put 'abbrev-mode 'safe-local-variable 'booleanp) ;;;*** ;;;### (autoloads (list-one-abbrev-table) "abbrevlist" "abbrevlist.el" -;;;;;; (17842 58280)) +;;;;;; (17994 6715)) ;;; Generated autoloads from abbrevlist.el (autoload (quote list-one-abbrev-table) "abbrevlist" "\ @@ -81,7 +81,7 @@ Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (17842 56333)) +;;;;;; (17994 6715)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload (quote ada-add-extensions) "ada-mode" "\ @@ -142,7 +142,7 @@ If you use ada-xref.el: ;;;*** ;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el" -;;;;;; (17842 56333)) +;;;;;; (17994 6715)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload (quote ada-header) "ada-stmt" "\ @@ -153,7 +153,7 @@ Insert a descriptive header at the top of the file. ;;;*** ;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el" -;;;;;; (17842 56333)) +;;;;;; (17994 6715)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload (quote ada-find-file) "ada-xref" "\ @@ -168,7 +168,7 @@ Completion is available. ;;;;;; change-log-mode add-change-log-entry-other-window add-change-log-entry ;;;;;; find-change-log prompt-for-change-log-name add-log-mailing-address ;;;;;; add-log-full-name add-log-current-defun-function) "add-log" -;;;;;; "add-log.el" (17851 44469)) +;;;;;; "add-log.el" (17994 6715)) ;;; Generated autoloads from add-log.el (defvar add-log-current-defun-function nil "\ @@ -306,7 +306,7 @@ Fix any old-style date entries in the current log file to default format. ;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice ;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action) -;;;;;; "advice" "emacs-lisp/advice.el" (17992 30878)) +;;;;;; "advice" "emacs-lisp/advice.el" (17994 6740)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action (quote warn) "\ @@ -434,7 +434,7 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation. ;;;### (autoloads (align-newline-and-indent align-unhighlight-rule ;;;;;; align-highlight-rule align-current align-entire align-regexp -;;;;;; align) "align" "align.el" (17842 58280)) +;;;;;; align) "align" "align.el" (17994 6715)) ;;; Generated autoloads from align.el (autoload (quote align) "align" "\ @@ -524,7 +524,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;*** ;;;### (autoloads (outlineify-sticky allout-mode) "allout" "allout.el" -;;;;;; (17892 52945)) +;;;;;; (17994 6715)) ;;; Generated autoloads from allout.el (put (quote allout-show-bodies) (quote safe-local-variable) (if (fboundp (quote booleanp)) (quote booleanp) (quote (lambda (x) (member x (quote (t nil))))))) @@ -830,7 +830,7 @@ setup for auto-startup. ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (17905 9579)) +;;;;;; "net/ange-ftp.el" (17994 6715)) ;;; Generated autoloads from net/ange-ftp.el (defalias (quote ange-ftp-re-read-dir) (quote ange-ftp-reread-dir)) @@ -852,7 +852,7 @@ Not documented ;;;*** ;;;### (autoloads (animate-birthday-present animate-sequence animate-string) -;;;;;; "animate" "play/animate.el" (17941 38806)) +;;;;;; "animate" "play/animate.el" (17994 6715)) ;;; Generated autoloads from play/animate.el (autoload (quote animate-string) "animate" "\ @@ -880,7 +880,7 @@ You can specify the one's name by NAME; the default value is \"Sarah\". ;;;*** ;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) -;;;;;; "ansi-color" "ansi-color.el" (17842 58280)) +;;;;;; "ansi-color" "ansi-color.el" (17994 6715)) ;;; Generated autoloads from ansi-color.el (autoload (quote ansi-color-for-comint-mode-on) "ansi-color" "\ @@ -1455,6 +1455,22 @@ Special commands: ;;;*** +;;;### (autoloads (auto-show-mode auto-show-mode) "auto-show" "obsolete/auto-show.el" +;;;;;; (17994 6715)) +;;; Generated autoloads from obsolete/auto-show.el + +(defvar auto-show-mode nil "\ +Obsolete.") + +(custom-autoload (quote auto-show-mode) "auto-show" t) + +(autoload (quote auto-show-mode) "auto-show" "\ +This command is obsolete. + +\(fn ARG)" t nil) + +;;;*** + ;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el" ;;;;;; (17842 58280)) ;;; Generated autoloads from autoarg.el @@ -9055,7 +9071,7 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote ;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor ;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" -;;;;;; "emerge.el" (17166 62192)) +;;;;;; "emerge.el" (17994 6715)) ;;; Generated autoloads from emerge.el (defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge")) @@ -9153,11 +9169,9 @@ You should not turn this mode on manually, instead use the command \\[set-keyboard-coding-system] which turns on or off this mode automatically. -In Encoded-kbd mode, a text sent from keyboard is accepted -as a multilingual text encoded in a coding system set by -\\[set-keyboard-coding-system]. +DISPLAY may be a display id, a frame, or nil for the selected frame's display. -\(fn &optional ARG)" t nil) +\(fn DISPLAY)" nil nil) ;;;*** @@ -10719,6 +10733,46 @@ argument BUFFER-NAME is nil, it defaults to *Colors*. ;;;*** +;;;### (autoloads (turn-on-fast-lock fast-lock-mode) "fast-lock" +;;;;;; "obsolete/fast-lock.el" (17994 6715)) +;;; Generated autoloads from obsolete/fast-lock.el + +(autoload (quote fast-lock-mode) "fast-lock" "\ +Toggle Fast Lock mode. +With arg, turn Fast Lock mode on if and only if arg is positive and the buffer +is associated with a file. Enable it automatically in your `~/.emacs' by: + + (setq font-lock-support-mode 'fast-lock-mode) + +If Fast Lock mode is enabled, and the current buffer does not contain any text +properties, any associated Font Lock cache is used if its timestamp matches the +buffer's file, and its `font-lock-keywords' match those that you are using. + +Font Lock caches may be saved: +- When you save the file's buffer. +- When you kill an unmodified file's buffer. +- When you exit Emacs, for all unmodified or saved buffers. +Depending on the value of `fast-lock-save-events'. +See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'. + +Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad. + +Various methods of control are provided for the Font Lock cache. In general, +see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'. +For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events', +`fast-lock-save-others' and `fast-lock-save-faces'. + +\(fn &optional ARG)" t nil) + +(autoload (quote turn-on-fast-lock) "fast-lock" "\ +Unconditionally turn on Fast Lock mode. + +\(fn)" nil nil) + +(when (fboundp (quote add-minor-mode)) (defvar fast-lock-mode nil) (add-minor-mode (quote fast-lock-mode) nil)) + +;;;*** + ;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue ;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts ;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (17888 29839)) @@ -13106,10 +13160,11 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound. (autoload (quote describe-variable) "help-fns" "\ Display the full documentation of VARIABLE (a symbol). Returns the documentation as a string, also. -If VARIABLE has a buffer-local value in BUFFER (default to the current buffer), +If VARIABLE has a buffer-local value in BUFFER or FRAME +\(default to the current buffer and current frame), it is displayed along with the global value. -\(fn VARIABLE &optional BUFFER)" t nil) +\(fn VARIABLE &optional BUFFER FRAME)" t nil) (autoload (quote describe-syntax) "help-fns" "\ Describe the syntax specifications in the syntax table of BUFFER. @@ -15924,6 +15979,37 @@ accessed via isearchb. ;;;*** +;;;### (autoloads (iso-accents-mode) "iso-acc" "obsolete/iso-acc.el" +;;;;;; (17994 6715)) +;;; Generated autoloads from obsolete/iso-acc.el + +(autoload (quote iso-accents-mode) "iso-acc" "\ +Toggle ISO Accents mode, in which accents modify the following letter. +This permits easy insertion of accented characters according to ISO-8859-1. +When Iso-accents mode is enabled, accent character keys +\(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following +letter key so that it inserts an ISO accented letter. + +You can customize ISO Accents mode to a particular language +with the command `iso-accents-customize'. + +Special combinations: ~c gives a c with cedilla, +~d gives an Icelandic eth (d with dash). +~t gives an Icelandic thorn. +\"s gives German sharp s. +/a gives a with ring. +/e gives an a-e ligature. +~< and ~> give guillemots. +~! gives an inverted exclamation mark. +~? gives an inverted question mark. + +With an argument, a positive argument enables ISO Accents mode, +and a negative argument disables it. + +\(fn &optional ARG)" t nil) + +;;;*** + ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only ;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso ;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" @@ -16847,6 +16933,74 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** +;;;### (autoloads (turn-on-lazy-lock lazy-lock-mode) "lazy-lock" +;;;;;; "obsolete/lazy-lock.el" (17994 6715)) +;;; Generated autoloads from obsolete/lazy-lock.el + +(autoload (quote lazy-lock-mode) "lazy-lock" "\ +Toggle Lazy Lock mode. +With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it +automatically in your `~/.emacs' by: + + (setq font-lock-support-mode 'lazy-lock-mode) + +For a newer font-lock support mode with similar functionality, see +`jit-lock-mode'. Eventually, Lazy Lock mode will be deprecated in +JIT Lock's favor. + +When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: + +- Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. + This means initial fontification does not occur if the buffer is greater than + `lazy-lock-minimum-size' characters in length. Instead, fontification occurs + when necessary, such as when scrolling through the buffer would otherwise + reveal unfontified areas. This is useful if buffer fontification is too slow + for large buffers. + +- Deferred scroll fontification if `lazy-lock-defer-on-scrolling' is non-nil. + This means demand-driven fontification does not occur as you scroll. + Instead, fontification is deferred until after `lazy-lock-defer-time' seconds + of Emacs idle time, while Emacs remains idle. This is useful if + fontification is too slow to keep up with scrolling. + +- Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil. + This means on-the-fly fontification does not occur as you type. Instead, + fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs + idle time, while Emacs remains idle. This is useful if fontification is too + slow to keep up with your typing. + +- Deferred context fontification if `lazy-lock-defer-contextually' is non-nil. + This means fontification updates the buffer corresponding to true syntactic + context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs + remains idle. Otherwise, fontification occurs on modified lines only, and + subsequent lines can remain fontified corresponding to previous syntactic + contexts. This is useful where strings or comments span lines. + +- Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. + This means remaining unfontified areas of buffers are fontified if Emacs has + been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. + This is useful if any buffer has any deferred fontification. + +Basic Font Lock mode on-the-fly fontification behavior fontifies modified +lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode +on-the-fly fontification may fontify differently, albeit correctly. In any +event, to refontify some lines you can use \\[font-lock-fontify-block]. + +Stealth fontification only occurs while the system remains unloaded. +If the system load rises above `lazy-lock-stealth-load' percent, stealth +fontification is suspended. Stealth fontification intensity is controlled via +the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and +verbosity is controlled via the variable `lazy-lock-stealth-verbose'. + +\(fn &optional ARG)" t nil) + +(autoload (quote turn-on-lazy-lock) "lazy-lock" "\ +Unconditionally turn on Lazy Lock mode. + +\(fn)" nil nil) + +;;;*** + ;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el" ;;;;;; (17842 56332)) ;;; Generated autoloads from progmodes/ld-script.el @@ -19010,10 +19164,10 @@ Major modes should set this variable.") (defvar comment-column 32 "\ Column to indent right-margin comments to. -Each mode establishes a different default value for this variable; you +Each mode may establish a different default value for this variable; you can set the value for a particular mode using that mode's hook. -Comments might be indented to a value smaller than this in order -not to go beyond `comment-fill-column'.") +Comments might be indented to a different value in order not to go beyond +`comment-fill-column' or in order to align them with surrounding comments.") (custom-autoload (quote comment-column) "newcomment" t) (put 'comment-column 'safe-local-variable 'integerp) @@ -19493,6 +19647,28 @@ including a reproducible test case and send the message. ;;;*** +;;;### (autoloads (edit-options list-options) "options" "obsolete/options.el" +;;;;;; (17994 6715)) +;;; Generated autoloads from obsolete/options.el + +(autoload (quote list-options) "options" "\ +Display a list of Emacs user options, with values and documentation. +It is now better to use Customize instead. + +\(fn)" t nil) + +(autoload (quote edit-options) "options" "\ +Edit a list of Emacs user option values. +Selects a buffer containing such a list, +in which there are commands to set the option values. +Type \\[describe-mode] in that buffer for a list of commands. + +The Custom feature is intended to make this obsolete. + +\(fn)" t nil) + +;;;*** + ;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files ;;;;;; org-export-icalendar-this-file org-diary org-tags-view org-todo-list ;;;;;; org-agenda-list org-cycle-agenda-files org-batch-agenda org-agenda @@ -23189,6 +23365,19 @@ Setting this variable has an effect only before reading a mail.") ;;;*** +;;;### (autoloads (news-post-news) "rnewspost" "obsolete/rnewspost.el" +;;;;;; (17994 6715)) +;;; Generated autoloads from obsolete/rnewspost.el + +(autoload (quote news-post-news) "rnewspost" "\ +Begin editing a new USENET news article to be posted. +Type \\[describe-mode] once editing the article to get a list of commands. +If NOQUERY is non-nil, we do not query before doing the work. + +\(fn &optional NOQUERY)" t nil) + +;;;*** + ;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region ;;;;;; rot13-string rot13) "rot13" "rot13.el" (17842 58279)) ;;; Generated autoloads from rot13.el @@ -23633,6 +23822,31 @@ This mode is an extended emacs-lisp mode. ;;;*** +;;;### (autoloads (scribe-mode) "scribe" "obsolete/scribe.el" (17994 +;;;;;; 6715)) +;;; Generated autoloads from obsolete/scribe.el + +(autoload (quote scribe-mode) "scribe" "\ +Major mode for editing files of Scribe (a text formatter) source. +Scribe-mode is similar to text-mode, with a few extra commands added. +\\{scribe-mode-map} + +Interesting variables: + +`scribe-fancy-paragraphs' + Non-nil makes Scribe mode use a different style of paragraph separation. + +`scribe-electric-quote' + Non-nil makes insert of double quote use `` or '' depending on context. + +`scribe-electric-parenthesis' + Non-nil makes an open-parenthesis char (one of `([<{') + automatically insert its close if typed after an @Command form. + +\(fn)" t nil) + +;;;*** + ;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el" ;;;;;; (17842 58278)) ;;; Generated autoloads from scroll-all.el @@ -23986,8 +24200,8 @@ Like `mail' command, but display mail buffer in another frame. (autoload (quote server-start) "server" "\ Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which -client \"editors\" can send your editing commands to this Emacs job. -To use the server, set up the program `emacsclient' in the +client \"editors\" can send your editing commands to this Emacs +job. To use the server, set up the program `emacsclient' in the Emacs distribution as your standard \"editor\". Optional argument LEAVE-DEAD (interactively, a prefix arg) means just @@ -24012,6 +24226,16 @@ Server mode runs a process that accepts commands from the \(fn &optional ARG)" t nil) +(autoload (quote server-save-buffers-kill-terminal) "server" "\ +Offer to save each buffer, then kill PROC. + +With prefix arg, silently save all file-visiting buffers, then kill. + +If emacsclient was started with a list of filenames to edit, then +only these files will be asked to be saved. + +\(fn PROC &optional ARG)" nil nil) + ;;;*** ;;;### (autoloads (ses-mode) "ses" "ses.el" (17902 31690)) @@ -25593,7 +25817,7 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** ;;;### (autoloads (studlify-buffer studlify-word studlify-region) -;;;;;; "studly" "play/studly.el" (16211 27038)) +;;;;;; "studly" "play/studly.el" (17994 6715)) ;;; Generated autoloads from play/studly.el (autoload (quote studlify-region) "studly" "\ @@ -26322,6 +26546,11 @@ Connect to display DISPLAY for the Emacs talk group. \(fn DISPLAY)" t nil) +(autoload (quote talk) "talk" "\ +Connect to the Emacs talk group from the current X display or tty frame. + +\(fn)" t nil) + ;;;*** ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (18010 5426)) @@ -27610,7 +27839,6 @@ PATTERN regexp. ;;;;;; "tmm.el" (17952 58711)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) - (define-key global-map [f10] 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) (autoload (quote tmm-menubar) "tmm" "\ @@ -27712,6 +27940,12 @@ Show TODO list. ;;;;;; (17842 58278)) ;;; Generated autoloads from tool-bar.el +(autoload (quote toggle-tool-bar-mode-from-frame) "tool-bar" "\ +Toggle tool bar on or off, based on the status of the current frame. +See `tool-bar-mode' for more information. + +\(fn &optional ARG)" t nil) + (put (quote tool-bar-mode) (quote standard-value) (quote (t))) (autoload (quote tool-bar-add-item) "tool-bar" "\ @@ -30987,13 +31221,13 @@ Zone out, completely. ;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "progmodes/xscheme.el" ;;;;;; "register.el" "replace.el" "rfn-eshadow.el" "s-region.el" ;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el" -;;;;;; "soundex.el" "startup.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el" -;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/page.el" -;;;;;; "textmodes/refbib.el" "textmodes/refer.el" "textmodes/reftex-auc.el" -;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" -;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "textmodes/text-mode.el" -;;;;;; "timezone.el" "tooltip.el" "tree-widget.el" "uniquify.el" -;;;;;; "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" +;;;;;; "soundex.el" "startup.el" "subdirs.el" "tempo.el" "termdev.el" +;;;;;; "textmodes/bib-mode.el" "textmodes/makeinfo.el" "textmodes/page-ext.el" +;;;;;; "textmodes/page.el" "textmodes/refbib.el" "textmodes/refer.el" +;;;;;; "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" +;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" +;;;;;; "textmodes/text-mode.el" "timezone.el" "tooltip.el" "tree-widget.el" +;;;;;; "uniquify.el" "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" ;;;;;; "url/url-expand.el" "url/url-ftp.el" "url/url-history.el" ;;;;;; "url/url-imap.el" "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" ;;;;;; "url/url-vars.el" "url/vc-dav.el" "vc-hooks.el" "vcursor.el" @@ -31003,9 +31237,9 @@ Zone out, completely. ;;;*** -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: +;;; Local Variables: +;;; version-control: never +;;; no-byte-compile: t +;;; no-update-autoloads: t +;;; End: ;;; loaddefs.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el index 7c144bf8315..b6464372a41 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -60,15 +60,17 @@ (load "widget") (load "custom") (load "emacs-lisp/map-ynp") -(load "env") (load "cus-start") (load "international/mule") (load "international/mule-conf.el") ;Don't get confused if someone compiled this by mistake. +(load "env") (load "format") (load "bindings") (setq load-source-file-function 'load-with-code-conversion) (load "files") +(load "startup") + (load "cus-face") (load "faces") ; after here, `defface' may be used. @@ -131,6 +133,7 @@ (load "indent") (load "window") (load "frame") +(load "termdev") (load "term/tty-colors") (load "font-core") ;; facemenu must be loaded before font-lock, because `facemenu-keymap' @@ -153,7 +156,6 @@ (message "%s" (garbage-collect)) (load "menu-bar") (load "paths.el") ;Don't get confused if someone compiled paths by mistake. -(load "startup") (load "emacs-lisp/lisp") (load "textmodes/page") (load "register") @@ -179,7 +181,10 @@ (load "mwheel") (load "tool-bar"))) (if (featurep 'x) - (load "x-dnd")) + (progn + (load "x-dnd") + (load "term/x-win"))) + (message "%s" (garbage-collect)) (if (eq system-type 'vax-vms) @@ -187,6 +192,9 @@ (load "vms-patch"))) (if (eq system-type 'windows-nt) (progn + (load "international/ccl") + (load "international/code-pages") + (load "term/w32-win") (load "ls-lisp") (load "disp-table") ; needed to setup ibm-pc char set, see internal.el (load "dos-w32") @@ -204,6 +212,9 @@ (if (eq system-type 'macos) (progn (load "ls-lisp"))) +(if (featurep 'mac-carbon) + (progn + (load "term/mac-win"))) (if (fboundp 'atan) ; preload some constants and (progn ; floating pt. functions if we have float support. (load "emacs-lisp/float-sup"))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d9f6405cf57..7d9dff8c501 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -929,15 +929,15 @@ mail status in mode line")) :button `(:toggle . tooltip-mode))) (define-key menu-bar-showhide-menu [menu-bar-mode] - '(menu-item "Menu-bar" menu-bar-mode + '(menu-item "Menu-bar" toggle-menu-bar-mode-from-frame :help "Turn menu-bar on/off" - :button (:toggle . menu-bar-mode))) + :button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0)))) (define-key menu-bar-showhide-menu [showhide-tool-bar] - (list 'menu-item "Tool-bar" 'tool-bar-mode - :help "Turn tool-bar on/off" + (list 'menu-item "Tool-bar" 'toggle-tool-bar-mode-from-frame + :help "Toggle tool-bar on/off" :visible `(display-graphic-p) - :button `(:toggle . tool-bar-mode))) + :button `(:toggle . (> (frame-parameter nil 'tool-bar-lines) 0)))) (define-key menu-bar-options-menu [showhide] (list 'menu-item "Show/Hide" menu-bar-showhide-menu)) @@ -1749,18 +1749,10 @@ turn on menu bars; otherwise, turn off menu bars." :init-value nil :global t :group 'frames + ;; Make menu-bar-mode and default-frame-alist consistent. - (let ((lines (if menu-bar-mode 1 0))) - ;; Alter existing frames... - (mapc (lambda (frame) - (modify-frame-parameters frame - (list (cons 'menu-bar-lines lines)))) - (frame-list)) - ;; ...and future ones. - (let ((elt (assq 'menu-bar-lines default-frame-alist))) - (if elt - (setcdr elt lines) - (add-to-list 'default-frame-alist (cons 'menu-bar-lines lines))))) + (modify-all-frames-parameters (list (cons 'menu-bar-lines + (if menu-bar-mode 1 0)))) ;; Make the message appear when Emacs is idle. We can not call message ;; directly. The minor-mode message "Menu-bar mode disabled" comes @@ -1770,6 +1762,30 @@ turn on menu bars; otherwise, turn off menu bars." "Menu-bar mode disabled. Use M-x menu-bar-mode to make the menu bar appear.")) menu-bar-mode) +(defun toggle-menu-bar-mode-from-frame (&optional arg) + "Toggle menu bar on or off, based on the status of the current frame. +See `menu-bar-mode' for more information." + (interactive (list (or current-prefix-arg 'toggle))) + (if (eq arg 'toggle) + (menu-bar-mode (if (> (frame-parameter nil 'menu-bar-lines) 0) 0 1)) + (menu-bar-mode arg))) + +(defun menu-bar-open (&optional frame) + "Start key navigation of the menu bar in FRAME. + +This function decides which method to use to access the menu +depending on FRAME's terminal device. On X displays, it calls +`x-menu-bar-open'; otherwise it calls `tmm-menubar'. + +If FRAME is nil or not given, use the selected frame." + (interactive) + (if (eq window-system 'x) + (x-menu-bar-open frame) + (with-selected-frame (or frame (selected-frame)) + (tmm-menubar)))) + +(global-set-key [f10] 'menu-bar-open) + (provide 'menu-bar) ;;; arch-tag: 6e6a3c22-4ec4-4d3d-8190-583f8ef94ced diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 58a25ab5b88..b9f0986c33e 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -2004,7 +2004,7 @@ COLLAPSE non-nil means collapse the branch." (fillarray (car (cdr map)) 'ebrowse-electric-list-undefined) (fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined) (define-key map "\e" submap) - (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-z" 'suspend-frame) (define-key map "\C-h" 'Helper-help) (define-key map "?" 'Helper-describe-bindings) (define-key map "\C-c" nil) @@ -3964,7 +3964,7 @@ Prefix arg ARG says how much." (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) (define-key map "\e" submap) - (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-z" 'suspend-frame) (define-key map "\C-h" 'Helper-help) (define-key map "?" 'Helper-describe-bindings) (define-key map "\C-c" nil) diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 770e01ccbca..0a373058f66 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -92,21 +92,8 @@ This is nil while loading `scroll-bar.el', and t afterward.") (setq scroll-bar-mode value) (when scroll-bar-mode-explicit - ;; Apply it to default-frame-alist. - (let ((parameter (assq 'vertical-scroll-bars default-frame-alist))) - (if (consp parameter) - (setcdr parameter scroll-bar-mode) - (setq default-frame-alist - (cons (cons 'vertical-scroll-bars scroll-bar-mode) - default-frame-alist)))) - - ;; Apply it to existing frames. - (let ((frames (frame-list))) - (while frames - (modify-frame-parameters - (car frames) - (list (cons 'vertical-scroll-bars scroll-bar-mode))) - (setq frames (cdr frames)))))) + (modify-all-frames-parameters (list (cons 'vertical-scroll-bars + scroll-bar-mode))))) (defcustom scroll-bar-mode default-frame-scroll-bars "*Specify whether to have vertical scroll bars, and on which side. diff --git a/lisp/server.el b/lisp/server.el index 1bdeb07ca0f..a9907f9d3a3 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -8,6 +8,7 @@ ;; Keywords: processes ;; Changes by peck@sun.com and by rms. +;; Overhaul by Karoly Lorentey <lorentey@elte.hu> for multi-tty support. ;; This file is part of GNU Emacs. @@ -41,7 +42,7 @@ ;; This program transmits the file names to Emacs through ;; the server subprocess, and Emacs visits them and lets you edit them. -;; Note that any number of clients may dispatch files to emacs to be edited. +;; Note that any number of clients may dispatch files to Emacs to be edited. ;; When you finish editing a Server buffer, again call server-edit ;; to mark that buffer as done for the client and switch to the next @@ -138,12 +139,11 @@ If set, the server accepts remote connections; otherwise it is local." (defvar server-clients nil "List of current server clients. -Each element is (CLIENTID BUFFERS...) where CLIENTID is a string -that can be given to the server process to identify a client. -When a buffer is marked as \"done\", it is removed from this list.") +Each element is (PROC PROPERTIES...) where PROC is a process object, +and PROPERTIES is an association list of client properties.") (defvar server-buffer-clients nil - "List of client ids for clients requesting editing of current buffer.") + "List of client processes requesting editing of current buffer.") (make-variable-buffer-local 'server-buffer-clients) ;; Changing major modes should not erase this local. (put 'server-buffer-clients 'permanent-local t) @@ -197,34 +197,166 @@ are done with it in the server.") (defvar server-name "server") -(defvar server-socket-dir - (format "/tmp/emacs%d" (user-uid))) +(defvar server-socket-dir nil + "The directory in which to place the server socket. +Initialized by `server-start'.") + +(defun server-client (proc) + "Return the Emacs client corresponding to PROC. +PROC must be a process object. +The car of the result is PROC; the cdr is an association list. +See `server-client-get' and `server-client-set'." + (assq proc server-clients)) + +(defun server-client-get (client property) + "Get the value of PROPERTY in CLIENT. +CLIENT may be a process object, or a client returned by `server-client'. +Return nil if CLIENT has no such property." + (or (listp client) (setq client (server-client client))) + (cdr (assq property (cdr client)))) + +(defun server-client-set (client property value) + "Set the PROPERTY to VALUE in CLIENT, and return VALUE. +CLIENT may be a process object, or a client returned by `server-client'." + (let (p proc) + (if (listp client) + (setq proc (car client)) + (setq proc client + client (server-client client))) + (setq p (assq property client)) + (cond + (p (setcdr p value)) + (client (setcdr client (cons (cons property value) (cdr client)))) + (t (setq server-clients + `((,proc (,property . ,value)) . ,server-clients)))) + value)) + +(defun server-clients-with (property value) + "Return a list of clients with PROPERTY set to VALUE." + (let (result) + (dolist (client server-clients result) + (when (equal value (server-client-get client property)) + (setq result (cons (car client) result)))))) + +(defun server-add-client (proc) + "Create a client for process PROC, if it doesn't already have one. +New clients have no properties." + (unless (server-client proc) + (setq server-clients (cons (cons proc nil) + server-clients)))) + +(defun server-getenv-from (env variable) + "Get the value of VARIABLE in ENV. +VARIABLE should be a string. Value is nil if VARIABLE is +undefined in ENV. Otherwise, value is a string. + +ENV should be in the same format as `process-environment'." + (let (entry result) + (while (and env (null result)) + (setq entry (car env) + env (cdr env)) + (if (and (> (length entry) (length variable)) + (eq ?= (aref entry (length variable))) + (equal variable (substring entry 0 (length variable)))) + (setq result (substring entry (+ (length variable) 1))))) + result)) + +(defmacro server-with-environment (env vars &rest body) + "Evaluate BODY with environment variables VARS set to those in ENV. +The environment variables are then restored to their previous values. + +VARS should be a list of strings. +ENV should be in the same format as `process-environment'." + (declare (indent 2)) + (let ((old-env (make-symbol "old-env")) + (var (make-symbol "var")) + (value (make-symbol "value")) + (pair (make-symbol "pair"))) + `(let ((,old-env process-environment)) + (dolist (,var ,vars) + (let ((,value (server-getenv-from ,env ,var))) + (setq process-environment + (cons (if (null ,value) + ,var + (concat ,var "=" ,value)) + process-environment)))) + (unwind-protect + (progn ,@body) + (setq process-environment ,old-env))))) + +(defun server-delete-client (client &optional noframe) + "Delete CLIENT, including its buffers, terminals and frames. +If NOFRAME is non-nil, let the frames live. (To be used from +`delete-frame-functions'.)" + (server-log (concat "server-delete-client" (if noframe " noframe")) + client) + ;; Force a new lookup of client (prevents infinite recursion). + (setq client (server-client + (if (listp client) (car client) client))) + (let ((proc (car client)) + (buffers (server-client-get client 'buffers))) + (when client + + ;; Kill the client's buffers. + (dolist (buf buffers) + (when (buffer-live-p buf) + (with-current-buffer buf + ;; Kill the buffer if necessary. + (when (and (equal server-buffer-clients + (list proc)) + (or (and server-kill-new-buffers + (not server-existing-buffer)) + (server-temp-file-p)) + (not (buffer-modified-p))) + (let (flag) + (unwind-protect + (progn (setq server-buffer-clients nil) + (kill-buffer (current-buffer)) + (setq flag t)) + (unless flag + ;; Restore clients if user pressed C-g in `kill-buffer'. + (setq server-buffer-clients (list proc))))))))) + + ;; Delete the client's frames. + (unless noframe + (dolist (frame (frame-list)) + (when (and (frame-live-p frame) + (equal proc (frame-parameter frame 'client))) + ;; Prevent `server-handle-delete-frame' from calling us + ;; recursively. + (set-frame-parameter frame 'client nil) + (delete-frame frame)))) + + (setq server-clients (delq client server-clients)) + + ;; Delete the client's tty. + (let ((terminal (server-client-get client 'terminal))) + (when (eq (terminal-live-p terminal) t) + (delete-terminal terminal))) + + ;; Delete the client's process. + (if (eq (process-status (car client)) 'open) + (delete-process (car client))) + + (server-log "Deleted" proc)))) (defun server-log (string &optional client) - "If a *server* buffer exists, write STRING to it for logging purposes." + "If a *server* buffer exists, write STRING to it for logging purposes. +If CLIENT is non-nil, add a description of it to the logged +message." (when (get-buffer "*server*") (with-current-buffer "*server*" (goto-char (point-max)) (insert (current-time-string) - (if client (format " %s:" client) " ") + (cond + ((null client) " ") + ((listp client) (format " %s: " (car client))) + (t (format " %s: " client))) string) (or (bolp) (newline))))) (defun server-sentinel (proc msg) - (let ((client (assq proc server-clients))) - ;; Remove PROC from the list of clients. - (when client - (setq server-clients (delq client server-clients)) - (dolist (buf (cdr client)) - (with-current-buffer buf - ;; Remove PROC from the clients of each buffer. - (setq server-buffer-clients (delq proc server-buffer-clients)) - ;; Kill the buffer if necessary. - (when (and (null server-buffer-clients) - (or (and server-kill-new-buffers - (not server-existing-buffer)) - (server-temp-file-p))) - (kill-buffer (current-buffer))))))) + "The process sentinel for Emacs server connections." ;; If this is a new client process, set the query-on-exit flag to nil ;; for this process (it isn't inherited from the server process). (when (and (eq (process-status proc) 'open) @@ -236,47 +368,34 @@ are done with it in the server.") ;; (and (process-contact proc :server) ;; (eq (process-status proc) 'closed) ;; (ignore-errors (delete-file (process-get proc :server-file)))) - (server-log (format "Status changed to %s" (process-status proc)) proc)) - -(defun server-select-display (display) - ;; If the current frame is on `display' we're all set. - (unless (equal (frame-parameter (selected-frame) 'display) display) - ;; Otherwise, look for an existing frame there and select it. - (dolist (frame (frame-list)) - (when (equal (frame-parameter frame 'display) display) - (select-frame frame))) - ;; If there's no frame on that display yet, create and select one. - (unless (equal (frame-parameter (selected-frame) 'display) display) - (let* ((buffer (generate-new-buffer " *server-dummy*")) - (frame (make-frame-on-display - display - ;; Make it display (and remember) some dummy buffer, so - ;; we can detect later if the frame is in use or not. - `((server-dummmy-buffer . ,buffer) - ;; This frame may be deleted later (see - ;; server-unselect-display) so we want it to be as - ;; unobtrusive as possible. - (visibility . nil))))) - (select-frame frame) - (set-window-buffer (selected-window) buffer))))) - -(defun server-unselect-display (frame) - ;; If the temporary frame is in use (displays something real), make it - ;; visible. If not (which can happen if the user's customizations call - ;; pop-to-buffer etc.), delete it to avoid preserving the connection after - ;; the last real frame is deleted. - (if (and (eq (frame-first-window frame) - (next-window (frame-first-window frame) 'nomini)) - (eq (window-buffer (frame-first-window frame)) - (frame-parameter frame 'server-dummy-buffer))) - ;; The temp frame still only shows one buffer, and that is the - ;; internal temp buffer. - (delete-frame frame) - (set-frame-parameter frame 'visibility t)) - (kill-buffer (frame-parameter frame 'server-dummy-buffer)) - (set-frame-parameter frame 'server-dummy-buffer nil)) + (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc) + (server-delete-client proc)) + +(defun server-handle-delete-frame (frame) + "Delete the client connection when the emacsclient frame is deleted." + (let ((proc (frame-parameter frame 'client))) + (when (and (frame-live-p frame) + proc + ;; See if this is the last frame for this client. + (>= 1 (let ((frame-num 0)) + (dolist (f (frame-list)) + (when (eq proc (frame-parameter f 'client)) + (setq frame-num (1+ frame-num)))) + frame-num))) + (server-log (format "server-handle-delete-frame, frame %s" frame) proc) + (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. + +(defun server-handle-suspend-tty (terminal) + "Notify the emacsclient process to suspend itself when its tty device is suspended." + (dolist (proc (server-clients-with 'terminal terminal)) + (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc) + (condition-case err + (server-send-string proc "-suspend \n") + (file-error (condition-case nil (server-delete-client proc) (error nil)))))) (defun server-unquote-arg (arg) + "Remove &-quotation from ARG. +See `server-quote-arg' and `server-process-filter'." (replace-regexp-in-string "&." (lambda (s) (case (aref s 1) @@ -286,6 +405,26 @@ are done with it in the server.") (t " "))) arg t t)) +(defun server-quote-arg (arg) + "In ARG, insert a & before each &, each space, each newline, and -. +Change spaces to underscores, too, so that the return value never +contains a space. + +See `server-unquote-arg' and `server-process-filter'." + (replace-regexp-in-string + "[-&\n ]" (lambda (s) + (case (aref s 0) + (?& "&&") + (?- "&-") + (?\n "&n") + (?\s "&_"))) + arg t t)) + +(defun server-send-string (proc string) + "A wrapper around `proc-send-string' for logging." + (server-log (concat "Sent " string) proc) + (process-send-string proc string)) + (defun server-ensure-safe-dir (dir) "Make sure DIR is a directory with no race-condition issues. Creates the directory if necessary and makes sure: @@ -307,68 +446,85 @@ Creates the directory if necessary and makes sure: (defun server-start (&optional leave-dead) "Allow this Emacs process to be a server for client processes. This starts a server communications subprocess through which -client \"editors\" can send your editing commands to this Emacs job. -To use the server, set up the program `emacsclient' in the +client \"editors\" can send your editing commands to this Emacs +job. To use the server, set up the program `emacsclient' in the Emacs distribution as your standard \"editor\". Optional argument LEAVE-DEAD (interactively, a prefix arg) means just kill any existing server communications subprocess." (interactive "P") - (when server-process - ;; kill it dead! - (ignore-errors (delete-process server-process))) - ;; If this Emacs already had a server, clear out associated status. - (while server-clients - (let ((buffer (nth 1 (car server-clients)))) - (server-buffer-done buffer))) - ;; Now any previous server is properly stopped. - (unless leave-dead - (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) - (server-file (expand-file-name server-name server-dir))) - ;; Make sure there is a safe directory in which to place the socket. - (server-ensure-safe-dir server-dir) - ;; Remove any leftover socket or authentication file. - (ignore-errors (delete-file server-file)) - (when server-process - (server-log (message "Restarting server"))) - (letf (((default-file-modes) ?\700)) - (setq server-process - (apply #'make-network-process - :name server-name - :server t - :noquery t - :sentinel 'server-sentinel - :filter 'server-process-filter - ;; We must receive file names without being decoded. - ;; Those are decoded by server-process-filter according - ;; to file-name-coding-system. - :coding 'raw-text - ;; The rest of the args depends on the kind of socket used. - (if server-use-tcp - (list :family nil - :service t - :host (or server-host 'local) - :plist '(:authenticated nil)) - (list :family 'local - :service server-file - :plist '(:authenticated t))))) - (unless server-process (error "Could not start server process")) - (when server-use-tcp - (let ((auth-key - (loop - ;; The auth key is a 64-byte string of random chars in the - ;; range `!'..`~'. - for i below 64 - collect (+ 33 (random 94)) into auth - finally return (concat auth)))) - (process-put server-process :auth-key auth-key) - (with-temp-file server-file - (set-buffer-multibyte nil) - (setq buffer-file-coding-system 'no-conversion) - (insert (format-network-address - (process-contact server-process :local)) - " " (int-to-string (emacs-pid)) - "\n" auth-key)))))))) + (when (or + (not server-clients) + (yes-or-no-p + "The current server still has clients; delete them? ")) + ;; It is safe to get the user id now. + (setq server-socket-dir (or server-socket-dir + (format "/tmp/emacs%d" (user-uid)))) + (when server-process + ;; kill it dead! + (ignore-errors (delete-process server-process))) + ;; Delete the socket files made by previous server invocations. + (condition-case () + (delete-file (expand-file-name server-name server-socket-dir)) + (error nil)) + ;; If this Emacs already had a server, clear out associated status. + (while server-clients + (server-delete-client (car server-clients))) + ;; Now any previous server is properly stopped. + (if leave-dead + (progn + (server-log (message "Server stopped")) + (setq server-process nil)) + (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) + (server-file (expand-file-name server-name server-dir))) + ;; Make sure there is a safe directory in which to place the socket. + (server-ensure-safe-dir server-dir) + ;; Remove any leftover socket or authentication file. + (ignore-errors (delete-file server-file)) + (when server-process + (server-log (message "Restarting server"))) + (letf (((default-file-modes) ?\700)) + (add-hook 'suspend-tty-functions 'server-handle-suspend-tty) + (add-hook 'delete-frame-functions 'server-handle-delete-frame) + (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) + (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) + (setq server-process + (apply #'make-network-process + :name server-name + :server t + :noquery t + :sentinel 'server-sentinel + :filter 'server-process-filter + ;; We must receive file names without being decoded. + ;; Those are decoded by server-process-filter according + ;; to file-name-coding-system. + :coding 'raw-text + ;; The rest of the args depends on the kind of socket used. + (if server-use-tcp + (list :family nil + :service t + :host (or server-host 'local) + :plist '(:authenticated nil)) + (list :family 'local + :service server-file + :plist '(:authenticated t))))) + (unless server-process (error "Could not start server process")) + (when server-use-tcp + (let ((auth-key + (loop + ;; The auth key is a 64-byte string of random chars in the + ;; range `!'..`~'. + for i below 64 + collect (+ 33 (random 94)) into auth + finally return (concat auth)))) + (process-put server-process :auth-key auth-key) + (with-temp-file server-file + (set-buffer-multibyte nil) + (setq buffer-file-coding-system 'no-conversion) + (insert (format-network-address + (process-contact server-process :local)) + " " (int-to-string (emacs-pid)) + "\n" auth-key))))))))) ;;;###autoload (define-minor-mode server-mode @@ -385,25 +541,123 @@ Server mode runs a process that accepts commands from the (defun* server-process-filter (proc string) "Process a request from the server to edit some files. -PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." +PROC is the server process. STRING consists of a sequence of +commands prefixed by a dash. Some commands have arguments; these +are &-quoted and need to be decoded by `server-unquote-arg'. The +filter parses and executes these commands. + +To illustrate the protocol, here is an example command that +emacsclient sends to create a new X frame (note that the whole +sequence is sent on a single line): + + -version 21.3.50 xterm + -env HOME /home/lorentey + -env DISPLAY :0.0 + ... lots of other -env commands + -display :0.0 + -window-system + +The server normally sends back the single command `-good-version' +as a response. + +The following commands are accepted by the server: + +`-auth AUTH-STRING' + Authenticate the client using the secret authentication string + AUTH-STRING. + +`-version CLIENT-VERSION' + Check version numbers between server and client, and signal an + error if there is a mismatch. The server replies with + `-good-version' to confirm the match. + +`-env NAME=VALUE' + An environment variable on the client side. + +`-dir DIRNAME' + The current working directory of the client process. + +`-current-frame' + Forbid the creation of new frames. + +`-nowait' + Request that the next frame created should not be + associated with this client. + +`-display DISPLAY' + Set the display name to open X frames on. + +`-position LINE[:COLUMN]' + Go to the given line and column number + in the next file opened. + +`-file FILENAME' + Load the given file in the current frame. + +`-eval EXPR' + Evaluate EXPR as a Lisp expression and return the + result in -print commands. + +`-window-system' + Open a new X frame. + +`-tty DEVICENAME TYPE' + Open a new tty frame at the client. + +`-suspend' + Suspend this tty frame. The client sends this string in + response to SIGTSTP and SIGTTOU. The server must cease all I/O + on this tty until it gets a -resume command. + +`-resume' + Resume this tty frame. The client sends this string when it + gets the SIGCONT signal and it is the foreground process on its + controlling tty. + +`-ignore COMMENT' + Do nothing, but put the comment in the server + log. Useful for debugging. + + +The following commands are accepted by the client: + +`-good-version' + Signals a version match between the client and the server. + +`-emacs-pid PID' + Describes the process id of the Emacs process; + used to forward window change signals to it. + +`-window-system-unsupported' + Signals that the server does not + support creating X frames; the client must try again with a tty + frame. + +`-print STRING' + Print STRING on stdout. Used to send values + returned by -eval. + +`-error DESCRIPTION' + Signal an error (but continue processing). + +`-suspend' + Suspend this terminal, i.e., stop the client process. Sent + when the user presses C-z." + (server-log (concat "Received " string) proc) ;; First things first: let's check the authentication (unless (process-get proc :authenticated) (if (and (string-match "-auth \\(.*?\\)\n" string) - (equal (match-string 1 string) (process-get proc :auth-key))) - (progn - (setq string (substring string (match-end 0))) - (process-put proc :authenticated t) - (server-log "Authentication successful" proc)) + (equal (match-string 1 string) (process-get proc :auth-key))) + (progn + (setq string (substring string (match-end 0))) + (process-put proc :authenticated t) + (server-log "Authentication successful" proc)) (server-log "Authentication failed" proc) - (process-send-string proc "Authentication failed") + (server-send-string + proc (concat "-error " (server-quote-arg "Authentication failed"))) (delete-process proc) ;; We return immediately (return-from server-process-filter))) - (server-log string proc) - (let ((prev (process-get proc :previous-string))) - (when prev - (setq string (concat prev string)) - (process-put proc :previous-string nil))) (when (> (recursion-depth) 0) ;; We're inside a minibuffer already, so if the emacs-client is trying ;; to open a frame on a new display, we might end up with an unusable @@ -412,7 +666,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." ;; Similarly with recursive-edits such as the splash screen. (process-put proc :previous-string string) (run-with-timer 0 nil (lexical-let ((proc proc)) - (lambda () (server-process-filter proc "")))) + (lambda () (server-process-filter proc "")))) (top-level)) (condition-case nil ;; If we're running isearch, we must abort it to allow Emacs to @@ -424,102 +678,296 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." (buffer-list)) ;; Signaled by isearch-cancel (quit (message nil))) - ;; If the input is multiple lines, - ;; process each line individually. - (while (string-match "\n" string) - (let ((request (substring string 0 (match-beginning 0))) - (coding-system (and default-enable-multibyte-characters - (or file-name-coding-system - default-file-name-coding-system))) - client nowait eval - (files nil) - (lineno 1) - (tmp-frame nil) ;; Sometimes used to embody the selected display. - (columnno 0)) - ;; Remove this line from STRING. - (setq string (substring string (match-end 0))) - (setq client (cons proc nil)) - (while (string-match "[^ ]* " request) - (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) - (setq request (substring request (match-end 0))) - (cond - ((equal "-nowait" arg) (setq nowait t)) - ((equal "-eval" arg) (setq eval t)) - ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) - (let ((display (server-unquote-arg (match-string 1 request)))) - (setq request (substring request (match-end 0))) - (condition-case err - (setq tmp-frame (server-select-display display)) - (error (process-send-string proc (nth 1 err)) - (setq request ""))))) - ;; ARG is a line number option. - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq lineno (string-to-number (substring arg 1)))) - ;; ARG is line number:column option. - ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) - (setq lineno (string-to-number (match-string 1 arg)) - columnno (string-to-number (match-string 2 arg)))) - (t - ;; Undo the quoting that emacsclient does - ;; for certain special characters. - (setq arg (server-unquote-arg arg)) - ;; Now decode the file name if necessary. - (when coding-system - (setq arg (decode-coding-string arg coding-system))) - (if eval - (let* (errorp - (v (condition-case errobj - (eval (car (read-from-string arg))) - (error (setq errorp t) errobj)))) - (when v - (with-temp-buffer - (let ((standard-output (current-buffer))) - (when errorp (princ "error: ")) - (pp v) - (ignore-errors - (process-send-region proc (point-min) (point-max))) - )))) - ;; ARG is a file name. - ;; Collapse multiple slashes to single slashes. - (setq arg (command-line-normalize-file-name arg)) - (push (list arg lineno columnno) files)) - (setq lineno 1) - (setq columnno 0))))) - (when files - (run-hooks 'pre-command-hook) - (server-visit-files files client nowait) - (run-hooks 'post-command-hook)) - ;; CLIENT is now a list (CLIENTNUM BUFFERS...) - (if (null (cdr client)) - ;; This client is empty; get rid of it immediately. - (progn - (delete-process proc) - (server-log "Close empty client" proc)) - ;; We visited some buffer for this client. - (or nowait (push client server-clients)) - (unless (or isearch-mode (minibufferp)) - (server-switch-buffer (nth 1 client)) - (run-hooks 'server-switch-hook) - (unless nowait - (message "%s" (substitute-command-keys - "When done with a buffer, type \\[server-edit]"))))) - (when (frame-live-p tmp-frame) - ;; Delete tmp-frame or make it visible depending on whether it's - ;; been used or not. - (server-unselect-display tmp-frame)))) - ;; Save for later any partial line that remains. - (when (> (length string) 0) - (process-put proc :previous-string string))) + (let ((prev (process-get proc 'previous-string))) + (when prev + (setq string (concat prev string)) + (process-put proc 'previous-string nil))) + (condition-case err + (progn + (server-add-client proc) + ;; If the input is multiple lines, + ;; process each line individually. + (while (string-match "\n" string) + (let ((request (substring string 0 (match-beginning 0))) + (coding-system (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system))) + (client (server-client proc)) + current-frame + nowait ; t if emacsclient does not want to wait for us. + frame ; The frame that was opened for the client (if any). + display ; Open the frame on this display. + dontkill ; t if the client should not be killed. + env + dir + (files nil) + (lineno 1) + (columnno 0)) + ;; Remove this line from STRING. + (setq string (substring string (match-end 0))) + (while (string-match " *[^ ]* " request) + (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) + (setq request (substring request (match-end 0))) + (cond + ;; -version CLIENT-VERSION: + ;; Check version numbers, signal an error if there is a mismatch. + ((and (equal "-version" arg) + (string-match "\\([0-9.]+\\) " request)) + (let* ((client-version (match-string 1 request)) + (truncated-emacs-version + (substring emacs-version 0 (length client-version)))) + (setq request (substring request (match-end 0))) + (if (equal client-version truncated-emacs-version) + (progn + (server-send-string proc "-good-version \n") + (server-client-set client 'version client-version)) + (error (concat "Version mismatch: Emacs is " + truncated-emacs-version + ", emacsclient is " client-version))))) + + ;; -nowait: Emacsclient won't wait for a result. + ((equal "-nowait" arg) (setq nowait t)) + + ;; -current-frame: Don't create frames. + ((equal "-current-frame" arg) (setq current-frame t)) + + ;; -display DISPLAY: + ;; Open X frames on the given display instead of the default. + ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) + (setq display (match-string 1 request) + request (substring request (match-end 0)))) + + ;; -window-system: Open a new X frame. + ((equal "-window-system" arg) + (unless (server-client-get client 'version) + (error "Protocol error; make sure to use the correct version of emacsclient")) + (unless current-frame + (if (fboundp 'x-create-frame) + (let ((params (if nowait + ;; Flag frame as client-created, but use a dummy client. + ;; This will prevent the frame from being deleted when + ;; emacsclient quits while also preventing + ;; `server-save-buffers-kill-terminal' from unexpectedly + ;; killing emacs on that frame. + (list (cons 'client 'nowait) (cons 'environment env)) + (list (cons 'client proc) (cons 'environment env))))) + (setq frame (make-frame-on-display + (or display + (frame-parameter nil 'display) + (getenv "DISPLAY") + (error "Please specify display")) + params)) + (server-log (format "%s created" frame) proc) + ;; XXX We need to ensure the parameters are + ;; really set because Emacs forgets unhandled + ;; initialization parameters for X frames at + ;; the moment. + (modify-frame-parameters frame params) + (set-frame-parameter frame 'display-environment-variable + (server-getenv-from env "DISPLAY")) + (set-frame-parameter frame 'term-environment-variable + (server-getenv-from env "TERM")) + (select-frame frame) + (server-client-set client 'frame frame) + (server-client-set client 'terminal (frame-terminal frame)) + + ;; Display *scratch* by default. + (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) + + (setq dontkill t)) + ;; This emacs does not support X. + (server-log "Window system unsupported" proc) + (server-send-string proc "-window-system-unsupported \n") + (setq dontkill t)))) + + ;; -resume: Resume a suspended tty frame. + ((equal "-resume" arg) + (let ((terminal (server-client-get client 'terminal))) + (setq dontkill t) + (when (eq (terminal-live-p terminal) t) + (resume-tty terminal)))) + + ;; -suspend: Suspend the client's frame. (In case we + ;; get out of sync, and a C-z sends a SIGTSTP to + ;; emacsclient.) + ((equal "-suspend" arg) + (let ((terminal (server-client-get client 'terminal))) + (setq dontkill t) + (when (eq (terminal-live-p terminal) t) + (suspend-tty terminal)))) + + ;; -ignore COMMENT: Noop; useful for debugging emacsclient. + ;; (The given comment appears in the server log.) + ((and (equal "-ignore" arg) (string-match "\\([^ ]*\\) " request)) + (setq dontkill t + request (substring request (match-end 0)))) + + ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. + ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request)) + (let ((tty (server-unquote-arg (match-string 1 request))) + (type (server-unquote-arg (match-string 2 request)))) + (setq request (substring request (match-end 0))) + (unless (server-client-get client 'version) + (error "Protocol error; make sure you use the correct version of emacsclient")) + (unless current-frame + (server-with-environment env + '("LANG" "LC_CTYPE" "LC_ALL" + ;; For tgetent(3); list according to ncurses(3). + "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" + "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" + "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" + "TERMINFO_DIRS" "TERMPATH" + ;; rxvt wants these + "COLORFGBG" "COLORTERM") + (setq frame (make-frame-on-tty tty type + ;; Ignore nowait here; we always need to clean + ;; up opened ttys when the client dies. + `((client . ,proc) + (environment . ,env))))) + + (set-frame-parameter frame 'display-environment-variable + (server-getenv-from env "DISPLAY")) + (set-frame-parameter frame 'term-environment-variable + (server-getenv-from env "TERM")) + (select-frame frame) + (server-client-set client 'frame frame) + (server-client-set client 'tty (terminal-name frame)) + (server-client-set client 'terminal (frame-terminal frame)) + + ;; Display *scratch* by default. + (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) + + ;; Reply with our pid. + (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) + (setq dontkill t)))) + + ;; -position LINE: Go to the given line in the next file. + ((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request)) + (setq lineno (string-to-number (substring (match-string 1 request) 1)) + request (substring request (match-end 0)))) + + ;; -position LINE:COLUMN: Set point to the given position in the next file. + ((and (equal "-position" arg) (string-match "\\+\\([0-9]+\\):\\([0-9]+\\) " request)) + (setq lineno (string-to-number (match-string 1 request)) + columnno (string-to-number (match-string 2 request)) + request (substring request (match-end 0)))) + + ;; -file FILENAME: Load the given file. + ((and (equal "-file" arg) (string-match "\\([^ ]+\\) " request)) + (let ((file (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq file (decode-coding-string file coding-system))) + (setq file (command-line-normalize-file-name file)) + (push (list file lineno columnno) files) + (server-log (format "New file: %s (%d:%d)" file lineno columnno) proc)) + (setq lineno 1 + columnno 0)) + + ;; -eval EXPR: Evaluate a Lisp expression. + ((and (equal "-eval" arg) (string-match "\\([^ ]+\\) " request)) + (let ((expr (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq expr (decode-coding-string expr coding-system))) + (let ((v (eval (car (read-from-string expr))))) + (when (and (not frame) v) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (pp v) + (server-send-string + proc (format "-print %s\n" + (server-quote-arg + (buffer-substring-no-properties (point-min) + (point-max))))))))) + (setq lineno 1 + columnno 0))) + + ;; -env NAME=VALUE: An environment variable. + ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request)) + (let ((var (server-unquote-arg (match-string 1 request)))) + ;; XXX Variables should be encoded as in getenv/setenv. + (setq request (substring request (match-end 0))) + (setq env (cons var env)))) + + ;; -dir DIRNAME: The cwd of the emacsclient process. + ((and (equal "-dir" arg) (string-match "\\([^ ]+\\) " request)) + (setq dir (server-unquote-arg (match-string 1 request))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq dir (decode-coding-string dir coding-system))) + (setq dir (command-line-normalize-file-name dir))) + + ;; Unknown command. + (t (error "Unknown command: %s" arg))))) + + (let (buffers) + (when files + (run-hooks 'pre-command-hook) + (setq buffers (server-visit-files files client nowait)) + (run-hooks 'post-command-hook)) + + (when frame + (with-selected-frame frame + (display-startup-echo-area-message) + (unless inhibit-splash-screen + (condition-case err + ;; This looks scary because `fancy-splash-screens' + ;; will call `recursive-edit' from a process filter. + ;; However, that should be safe to do now. + (display-splash-screen t) + ;; `recursive-edit' will throw an error if Emacs is + ;; already doing a recursive edit elsewhere. Catch it + ;; here so that we can finish normally. + (error nil))))) + + ;; Delete the client if necessary. + (cond + (nowait + ;; Client requested nowait; return immediately. + (server-log "Close nowait client" proc) + (server-delete-client proc)) + ((and (not dontkill) (null buffers)) + ;; This client is empty; get rid of it immediately. + (server-log "Close empty client" proc) + (server-delete-client proc))) + (cond + ((or isearch-mode (minibufferp)) + nil) + ((and frame (null buffers)) + (message "%s" (substitute-command-keys + "When done with this frame, type \\[delete-frame]"))) + ((not (null buffers)) + (server-switch-buffer (car buffers)) + (run-hooks 'server-switch-hook) + (unless nowait + (message "%s" (substitute-command-keys + "When done with a buffer, type \\[server-edit]")))))))) + + ;; Save for later any partial line that remains. + (when (> (length string) 0) + (process-put proc 'previous-string string))) + ;; condition-case + (error (ignore-errors + (server-send-string + proc (concat "-error " (server-quote-arg (error-message-string err)))) + (setq string "") + (server-log (error-message-string err) proc) + (delete-process proc))))) (defun server-goto-line-column (file-line-col) + "Move point to the position indicated in FILE-LINE-COL. +FILE-LINE-COL should be a three-element list as described in +`server-visit-files'." (goto-line (nth 1 file-line-col)) (let ((column-number (nth 2 file-line-col))) - (when (> column-number 0) - (move-to-column (1- column-number))))) + (if (> column-number 0) + (move-to-column (1- column-number))))) (defun server-visit-files (files client &optional nowait) - "Find FILES and return the list CLIENT with the buffers nconc'd. + "Find FILES and return a list of buffers created. FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER). +CLIENT is the client that requested this operation. NOWAIT non-nil means this client is not waiting for the results, so don't mark these buffers specially, just visit them normally." ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries. @@ -533,7 +981,7 @@ so don't mark these buffers specially, just visit them normally." ;; modified, revert it. If there is an existing buffer with ;; deleted file, offer to write it. (let* ((minibuffer-auto-raise (or server-raise-frame - minibuffer-auto-raise)) + minibuffer-auto-raise)) (filen (car file)) (obuf (get-file-buffer filen))) (add-to-history 'file-name-history filen) @@ -541,14 +989,14 @@ so don't mark these buffers specially, just visit them normally." (progn (cond ((file-exists-p filen) (when (not (verify-visited-file-modtime obuf)) - (revert-buffer t nil))) + (revert-buffer t nil))) (t (when (y-or-n-p - (concat "File no longer exists: " - filen - ", write buffer to file? ")) - (write-file filen)))) - (setq server-existing-buffer t) + (concat "File no longer exists: " filen + ", write buffer to file? ")) + (write-file filen)))) + (unless server-buffer-clients + (setq server-existing-buffer t)) (server-goto-line-column file)) (set-buffer (find-file-noselect filen)) (server-goto-line-column file) @@ -558,7 +1006,11 @@ so don't mark these buffers specially, just visit them normally." (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) (push (car client) server-buffer-clients)) (push (current-buffer) client-record))) - (nconc client client-record))) + (unless nowait + (server-client-set + client 'buffers + (nconc (server-client-get client 'buffers) client-record))) + client-record)) (defun server-buffer-done (buffer &optional for-killing) "Mark BUFFER as \"done\" for its client(s). @@ -568,27 +1020,24 @@ or nil. KILLED is t if we killed BUFFER (typically, because it was visiting a temp file). FOR-KILLING if non-nil indicates that we are called from `kill-buffer'." (let ((next-buffer nil) - (killed nil) - (old-clients server-clients)) - (while old-clients - (let ((client (car old-clients))) + (killed nil)) + (dolist (client server-clients) + (let ((buffers (server-client-get client 'buffers))) (or next-buffer - (setq next-buffer (nth 1 (memq buffer client)))) - (delq buffer client) - ;; Delete all dead buffers from CLIENT. - (let ((tail client)) - (while tail - (and (bufferp (car tail)) - (null (buffer-name (car tail))) - (delq (car tail) client)) - (setq tail (cdr tail)))) - ;; If client now has no pending buffers, - ;; tell it that it is done, and forget it entirely. - (unless (cdr client) - (delete-process (car client)) - (server-log "Close" (car client)) - (setq server-clients (delq client server-clients)))) - (setq old-clients (cdr old-clients))) + (setq next-buffer (nth 1 (memq buffer buffers)))) + (when buffers ; Ignore bufferless clients. + (setq buffers (delq buffer buffers)) + ;; Delete all dead buffers from CLIENT. + (dolist (b buffers) + (and (bufferp b) + (not (buffer-live-p b)) + (setq buffers (delq b buffers)))) + (server-client-set client 'buffers buffers) + ;; If client now has no pending buffers, + ;; tell it that it is done, and forget it entirely. + (unless buffers + (server-log "Close" client) + (server-delete-client client))))) (when (and (bufferp buffer) (buffer-name buffer)) ;; We may or may not kill this buffer; ;; if we do, do not call server-buffer-done recursively @@ -653,30 +1102,32 @@ specifically for the clients and did not exist before their request for it." ;; but I think that is dangerous--the client would proceed ;; using whatever is on disk in that file. -- rms. (defun server-kill-buffer-query-function () + "Ask before killing a server buffer." (or (not server-buffer-clients) + (let ((res t)) + (dolist (proc server-buffer-clients res) + (let ((client (server-client proc))) + (when (and client (eq (process-status proc) 'open)) + (setq res nil))))) (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " (buffer-name (current-buffer)))))) -(add-hook 'kill-buffer-query-functions - 'server-kill-buffer-query-function) - (defun server-kill-emacs-query-function () - (let (live-client - (tail server-clients)) - ;; See if any clients have any buffers that are still alive. - (while tail - (when (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) - (setq live-client t)) - (setq tail (cdr tail))) - (or (not live-client) - (yes-or-no-p "Server buffers still have clients; exit anyway? ")))) - -(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) + "Ask before exiting Emacs it has live clients." + (or (not server-clients) + (let (live-client) + (dolist (client server-clients live-client) + (when (memq t (mapcar 'buffer-live-p (server-client-get + client 'buffers))) + (setq live-client t)))) + (yes-or-no-p "This Emacs session has clients; exit anyway? "))) (defvar server-kill-buffer-running nil "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") (defun server-kill-buffer () + "Remove the current buffer from its clients' buffer list. +Designed to be added to `kill-buffer-hook'." ;; Prevent infinite recursion if user has made server-done-hook ;; call kill-buffer. (or server-kill-buffer-running @@ -710,18 +1161,26 @@ starts server process and that is all. Invoked by \\[server-edit]." (defun server-switch-buffer (&optional next-buffer killed-one) "Switch to another buffer, preferably one that has a client. -Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." - ;; KILLED-ONE is t in a recursive call - ;; if we have already killed one temp-file server buffer. - ;; This means we should avoid the final "switch to some other buffer" - ;; since we've already effectively done that. +Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it. + +KILLED-ONE is t in a recursive call if we have already killed one +temp-file server buffer. This means we should avoid the final +\"switch to some other buffer\" since we've already effectively +done that." (if (null next-buffer) - (if server-clients - (server-switch-buffer (nth 1 (car server-clients)) killed-one) - (unless (or killed-one (window-dedicated-p (selected-window))) - (switch-to-buffer (other-buffer)) + (progn + (let ((rest server-clients)) + (while (and rest (not next-buffer)) + (let ((client (car rest))) + ;; Only look at frameless clients. + (when (not (server-client-get client 'frame)) + (setq next-buffer (car (server-client-get client 'buffers)))) + (setq rest (cdr rest))))) + (and next-buffer (server-switch-buffer next-buffer killed-one)) + (unless (or next-buffer killed-one (window-dedicated-p (selected-window))) + ;; (switch-to-buffer (other-buffer)) (message "No server buffers remain to edit"))) - (if (not (buffer-name next-buffer)) + (if (not (buffer-live-p next-buffer)) ;; If NEXT-BUFFER is a dead buffer, remove the server records for it ;; and try the next surviving server buffer. (apply 'server-switch-buffer (server-buffer-done next-buffer)) @@ -749,8 +1208,8 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." (get-window-with-predicate (lambda (w) (and (not (window-dedicated-p w)) - (equal (frame-parameter (window-frame w) 'display) - (frame-parameter (selected-frame) 'display)))) + (equal (frame-terminal (window-frame w)) + (frame-terminal (selected-frame))))) 'nomini 'visible (selected-window)))) (condition-case nil (switch-to-buffer next-buffer) @@ -760,10 +1219,31 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it." (when server-raise-frame (select-frame-set-input-focus (window-frame (selected-window)))))) +;;;###autoload +(defun server-save-buffers-kill-terminal (proc &optional arg) + "Offer to save each buffer, then kill PROC. + +With prefix arg, silently save all file-visiting buffers, then kill. + +If emacsclient was started with a list of filenames to edit, then +only these files will be asked to be saved." + (let ((buffers (server-client-get proc 'buffers))) + ;; If client is bufferless, emulate a normal Emacs session + ;; exit and offer to save all buffers. Otherwise, offer to + ;; save only the buffers belonging to the client. + (save-some-buffers arg + (if buffers + (lambda () (memq (current-buffer) buffers)) + t)) + (server-delete-client proc))) + (define-key ctl-x-map "#" 'server-edit) (defun server-unload-hook () + "Unload the server library." (server-mode -1) + (remove-hook 'suspend-tty-functions 'server-handle-suspend-tty) + (remove-hook 'delete-frame-functions 'server-handle-delete-frame) (remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) (remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) (remove-hook 'kill-buffer-hook 'server-kill-buffer)) diff --git a/lisp/simple.el b/lisp/simple.el index ab7370b02ec..854b3713faf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -85,34 +85,22 @@ If the optional third argument FRAME is non-nil, use that frame's buffer list instead of the selected frame's buffer list. If no other buffer exists, the buffer `*scratch*' is returned." (setq frame (or frame (selected-frame))) - (or (get-next-valid-buffer (frame-parameter frame 'buried-buffer-list) - buffer visible-ok frame) - (get-next-valid-buffer (nreverse (buffer-list frame)) - buffer visible-ok frame) + (or (get-next-valid-buffer (nreverse (buffer-list frame)) + buffer visible-ok frame) (progn (set-buffer-major-mode (get-buffer-create "*scratch*")) (get-buffer "*scratch*")))) - (defun next-buffer () "Switch to the next buffer in cyclic order." (interactive) - (let ((buffer (current-buffer)) - (bbl (frame-parameter nil 'buried-buffer-list))) + (let ((buffer (current-buffer))) (switch-to-buffer (other-buffer buffer t)) - (bury-buffer buffer) - (set-frame-parameter nil 'buried-buffer-list - (cons buffer (delq buffer bbl))))) + (bury-buffer buffer))) (defun previous-buffer () "Switch to the previous buffer in cyclic order." (interactive) - (let ((buffer (last-buffer (current-buffer) t)) - (bbl (frame-parameter nil 'buried-buffer-list))) - (switch-to-buffer buffer) - ;; Clean up buried-buffer-list up to and including the chosen buffer. - (while (and bbl (not (eq (car bbl) buffer))) - (setq bbl (cdr bbl))) - (set-frame-parameter nil 'buried-buffer-list bbl))) + (switch-to-buffer (last-buffer (current-buffer) t))) ;;; next-error support framework @@ -2557,6 +2545,8 @@ the text which should be made available. The second, optional, argument PUSH, has the same meaning as the similar argument to `x-set-cut-buffer', which see.") +(make-variable-frame-local 'interprogram-cut-function) + (defvar interprogram-paste-function nil "Function to call to get text cut from other programs. @@ -2577,6 +2567,8 @@ most recent string, the function should return nil. If it is difficult to tell whether Emacs or some other program provided the current string, it is probably good enough to return nil if the string is equal (according to `string=') to the last text Emacs provided.") + +(make-variable-frame-local 'interprogram-paste-function) @@ -5605,36 +5597,33 @@ front of the list of recently selected ones." ;;; Handling of Backspace and Delete keys. -(defcustom normal-erase-is-backspace - (and (not noninteractive) - (or (memq system-type '(ms-dos windows-nt)) - (eq window-system 'mac) - (and (memq window-system '(x)) - (fboundp 'x-backspace-delete-keys-p) - (x-backspace-delete-keys-p)) - ;; If the terminal Emacs is running on has erase char - ;; set to ^H, use the Backspace key for deleting - ;; backward and, and the Delete key for deleting forward. - (and (null window-system) - (eq tty-erase-char ?\^H)))) - "If non-nil, Delete key deletes forward and Backspace key deletes backward. - -On window systems, the default value of this option is chosen -according to the keyboard used. If the keyboard has both a Backspace -key and a Delete key, and both are mapped to their usual meanings, the -option's default value is set to t, so that Backspace can be used to -delete backward, and Delete can be used to delete forward. - -If not running under a window system, customizing this option accomplishes -a similar effect by mapping C-h, which is usually generated by the -Backspace key, to DEL, and by mapping DEL to C-d via -`keyboard-translate'. The former functionality of C-h is available on -the F1 key. You should probably not use this setting if you don't -have both Backspace, Delete and F1 keys. +(defcustom normal-erase-is-backspace 'maybe + "Set the default behaviour of the Delete and Backspace keys. + +If set to t, Delete key deletes forward and Backspace key deletes +backward. + +If set to nil, both Delete and Backspace keys delete backward. + +If set to 'maybe (which is the default), Emacs automatically +selects a behaviour. On window systems, the behaviour depends on +the keyboard used. If the keyboard has both a Backspace key and +a Delete key, and both are mapped to their usual meanings, the +option's default value is set to t, so that Backspace can be used +to delete backward, and Delete can be used to delete forward. + +If not running under a window system, customizing this option +accomplishes a similar effect by mapping C-h, which is usually +generated by the Backspace key, to DEL, and by mapping DEL to C-d +via `keyboard-translate'. The former functionality of C-h is +available on the F1 key. You should probably not use this +setting if you don't have both Backspace, Delete and F1 keys. Setting this variable with setq doesn't take effect. Programmatically, call `normal-erase-is-backspace-mode' (which see) instead." - :type 'boolean + :type '(choice (const :tag "Off" nil) + (const :tag "Maybe" maybe) + (other :tag "On" t)) :group 'editing-basics :version "21.1" :set (lambda (symbol value) @@ -5644,17 +5633,38 @@ call `normal-erase-is-backspace-mode' (which see) instead." (normal-erase-is-backspace-mode (or value 0)) (set-default symbol value)))) +(defun normal-erase-is-backspace-setup-frame (&optional frame) + "Set up `normal-erase-is-backspace-mode' on FRAME, if necessary." + (unless frame (setq frame (selected-frame))) + (with-selected-frame frame + (unless (terminal-parameter nil 'normal-erase-is-backspace) + (if (cond ((eq normal-erase-is-backspace 'maybe) + (and (not noninteractive) + (or (memq system-type '(ms-dos windows-nt)) + (eq window-system 'mac) + (and (memq window-system '(x)) + (fboundp 'x-backspace-delete-keys-p) + (x-backspace-delete-keys-p)) + ;; If the terminal Emacs is running on has erase char + ;; set to ^H, use the Backspace key for deleting + ;; backward and, and the Delete key for deleting forward. + (and (null window-system) + (eq tty-erase-char ?\^H))))) + (t + normal-erase-is-backspace)) + (normal-erase-is-backspace-mode 1) + (normal-erase-is-backspace-mode 0))))) (defun normal-erase-is-backspace-mode (&optional arg) "Toggle the Erase and Delete mode of the Backspace and Delete keys. With numeric arg, turn the mode on if and only if ARG is positive. -On window systems, when this mode is on, Delete is mapped to C-d and -Backspace is mapped to DEL; when this mode is off, both Delete and -Backspace are mapped to DEL. (The remapping goes via -`function-key-map', so binding Delete or Backspace in the global or -local keymap will override that.) +On window systems, when this mode is on, Delete is mapped to C-d +and Backspace is mapped to DEL; when this mode is off, both +Delete and Backspace are mapped to DEL. (The remapping goes via +`local-function-key-map', so binding Delete or Backspace in the +global or local keymap will override that.) In addition, on window systems, the bindings of C-Delete, M-Delete, C-M-Delete, C-Backspace, M-Backspace, and C-M-Backspace are changed in @@ -5676,54 +5686,57 @@ have both Backspace, Delete and F1 keys. See also `normal-erase-is-backspace'." (interactive "P") - (setq normal-erase-is-backspace - (if arg - (> (prefix-numeric-value arg) 0) - (not normal-erase-is-backspace))) - - (cond ((or (memq window-system '(x w32 mac pc)) - (memq system-type '(ms-dos windows-nt))) - (let ((bindings - `(([C-delete] [C-backspace]) - ([M-delete] [M-backspace]) - ([C-M-delete] [C-M-backspace]) - (,esc-map - [C-delete] [C-backspace]))) - (old-state (lookup-key function-key-map [delete]))) - - (if normal-erase-is-backspace + (let ((enabled (or (and arg (> (prefix-numeric-value arg) 0)) + (and (not arg) + (not (eq 1 (terminal-parameter + nil 'normal-erase-is-backspace))))))) + (set-terminal-parameter nil 'normal-erase-is-backspace + (if enabled 1 0)) + + (cond ((or (memq window-system '(x w32 mac pc)) + (memq system-type '(ms-dos windows-nt))) + (let* ((bindings + `(([C-delete] [C-backspace]) + ([M-delete] [M-backspace]) + ([C-M-delete] [C-M-backspace]) + (,esc-map + [C-delete] [C-backspace]))) + (old-state (lookup-key local-function-key-map [delete]))) + + (if enabled + (progn + (define-key local-function-key-map [delete] [?\C-d]) + (define-key local-function-key-map [kp-delete] [?\C-d]) + (define-key local-function-key-map [backspace] [?\C-?])) + (define-key local-function-key-map [delete] [?\C-?]) + (define-key local-function-key-map [kp-delete] [?\C-?]) + (define-key local-function-key-map [backspace] [?\C-?])) + + ;; Maybe swap bindings of C-delete and C-backspace, etc. + (unless (equal old-state (lookup-key local-function-key-map [delete])) + (dolist (binding bindings) + (let ((map global-map)) + (when (keymapp (car binding)) + (setq map (car binding) binding (cdr binding))) + (let* ((key1 (nth 0 binding)) + (key2 (nth 1 binding)) + (binding1 (lookup-key map key1)) + (binding2 (lookup-key map key2))) + (define-key map key1 binding2) + (define-key map key2 binding1))))))) + (t + (if enabled (progn - (define-key function-key-map [delete] [?\C-d]) - (define-key function-key-map [kp-delete] [?\C-d]) - (define-key function-key-map [backspace] [?\C-?])) - (define-key function-key-map [delete] [?\C-?]) - (define-key function-key-map [kp-delete] [?\C-?]) - (define-key function-key-map [backspace] [?\C-?])) - - ;; Maybe swap bindings of C-delete and C-backspace, etc. - (unless (equal old-state (lookup-key function-key-map [delete])) - (dolist (binding bindings) - (let ((map global-map)) - (when (keymapp (car binding)) - (setq map (car binding) binding (cdr binding))) - (let* ((key1 (nth 0 binding)) - (key2 (nth 1 binding)) - (binding1 (lookup-key map key1)) - (binding2 (lookup-key map key2))) - (define-key map key1 binding2) - (define-key map key2 binding1))))))) - (t - (if normal-erase-is-backspace - (progn - (keyboard-translate ?\C-h ?\C-?) - (keyboard-translate ?\C-? ?\C-d)) - (keyboard-translate ?\C-h ?\C-h) - (keyboard-translate ?\C-? ?\C-?)))) - - (run-hooks 'normal-erase-is-backspace-hook) - (if (interactive-p) - (message "Delete key deletes %s" - (if normal-erase-is-backspace "forward" "backward")))) + (keyboard-translate ?\C-h ?\C-?) + (keyboard-translate ?\C-? ?\C-d)) + (keyboard-translate ?\C-h ?\C-h) + (keyboard-translate ?\C-? ?\C-?)))) + + (run-hooks 'normal-erase-is-backspace-hook) + (if (interactive-p) + (message "Delete key deletes %s" + (if (terminal-parameter nil 'normal-erase-is-backspace) + "forward" "backward"))))) (defvar vis-mode-saved-buffer-invisibility-spec nil "Saved value of `buffer-invisibility-spec' when Visible mode is on.") diff --git a/lisp/startup.el b/lisp/startup.el index 184a2424756..3ab65eba5d0 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -36,6 +36,13 @@ (defvar command-line-processed nil "Non-nil once command line has been processed.") +(defvar window-system initial-window-system + "Name of window system the selected frame is displaying through. +The value is a symbol--for instance, `x' for X windows. +The value is nil if the selected frame is on a text-only-terminal.") + +(make-variable-frame-local 'window-system) + (defgroup initialization nil "Emacs start-up procedure." :group 'internal) @@ -437,36 +444,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; for instance due to a dense colormap. (when (or frame-initial-frame ;; If frame-initial-frame has no meaning, do this anyway. - (not (and window-system + (not (and initial-window-system (not noninteractive) - (not (eq window-system 'pc))))) + (not (eq initial-window-system 'pc))))) ;; Modify the initial frame based on what .emacs puts into ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) (frame-notice-user-settings)) + ;; Set the faces for the initial background mode even if + ;; frame-notice-user-settings didn't (such as on a tty). + ;; frame-set-background-mode is idempotent, so it won't + ;; cause any harm if it's already been done. (if (fboundp 'frame-set-background-mode) - ;; Set the faces for the initial background mode even if - ;; frame-notice-user-settings didn't (such as on a tty). - ;; frame-set-background-mode is idempotent, so it won't - ;; cause any harm if it's already been done. - (let ((frame (selected-frame)) - term) - (when (and (null window-system) - ;; Don't override default set by files in lisp/term. - (null default-frame-background-mode) - (let ((bg (frame-parameter frame 'background-color))) - (or (null bg) - (member bg '(unspecified "unspecified-bg" - "unspecified-fg"))))) - - (setq term (getenv "TERM")) - ;; Some files in lisp/term do a better job with the - ;; background mode, but we leave this here anyway, in - ;; case they remove those files. - (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" - term) - (setq default-frame-background-mode 'light))) - (frame-set-background-mode (selected-frame))))) + (frame-set-background-mode (selected-frame)))) ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) @@ -507,6 +497,20 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (defvar tool-bar-originally-present nil "Non-nil if tool-bars are present before user and site init files are read.") +(defvar handle-args-function-alist '((nil . tty-handle-args)) + "Functions for processing window-system dependent command-line arguments. +Window system startup files should add their own function to this +alist, which should parse the command line arguments. Those +pertaining to the window system should be processed and removed +from the returned command line.") + +(defvar window-system-initialization-alist '((nil . ignore)) + "Alist of window-system initialization functions. +Window-system startup files should add their own initialization +function to this list. The function should take no arguments, +and initialize the window system environment to prepare for +opening the first frame (e.g. open a connection to an X server).") + ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) (let (rest) @@ -611,16 +615,22 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (setq eol-mnemonic-dos "(DOS)" eol-mnemonic-mac "(Mac)"))) - ;; Read window system's init file if using a window system. + ;; Make sure window system's init file was loaded in loadup.el if using a window system. (condition-case error - (if (and window-system (not noninteractive)) - (load (concat term-file-prefix - (symbol-name window-system) - "-win") - ;; Every window system should have a startup file; - ;; barf if we can't find it. - nil t)) - ;; If we can't read it, print the error message and exit. + (unless noninteractive + (if (and initial-window-system + (not (featurep + (intern (concat (symbol-name initial-window-system) "-win"))))) + (error "Unsupported window system `%s'" initial-window-system)) + ;; Process window-system specific command line parameters. + (setq command-line-args + (funcall (or (cdr (assq initial-window-system handle-args-function-alist)) + (error "Unsupported window system `%s'" initial-window-system)) + command-line-args)) + ;; Initialize the window system. (Open connection, etc.) + (funcall (or (cdr (assq initial-window-system window-system-initialization-alist)) + (error "Unsupported window system `%s'" initial-window-system)))) + ;; If there was an error, print the error message and exit. (error (princ (if (eq (car error) 'error) @@ -636,13 +646,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) - (setq window-system nil) + (setq initial-window-system nil) (kill-emacs))) - ;; Windowed displays do this inside their *-win.el. - (unless (or (display-graphic-p) noninteractive) - (setq command-line-args (tty-handle-args command-line-args))) - (set-locale-environment nil) ;; Convert preloaded file names in load-history to absolute. @@ -765,7 +771,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; If frame was created with a menu bar, set menu-bar-mode on. (unless (or noninteractive emacs-basic-display - (and (memq window-system '(x w32)) + (and (memq initial-window-system '(x w32)) (<= (frame-parameter nil 'menu-bar-lines) 0))) (menu-bar-mode 1)) @@ -779,7 +785,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Can't do this init in defcustom because the relevant variables ;; are not set. (custom-reevaluate-setting 'blink-cursor-mode) - (custom-reevaluate-setting 'normal-erase-is-backspace) (custom-reevaluate-setting 'tooltip-mode) (custom-reevaluate-setting 'global-font-lock-mode) (custom-reevaluate-setting 'mouse-wheel-down-event) @@ -788,13 +793,15 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (custom-reevaluate-setting 'send-mail-function) (custom-reevaluate-setting 'focus-follows-mouse) + (normal-erase-is-backspace-setup-frame) + ;; Register default TTY colors for the case the terminal hasn't a - ;; terminal init file. - (unless (memq window-system '(x w32 mac)) - ;; We do this regardles of whether the terminal supports colors - ;; or not, since they can switch that support on or off in - ;; mid-session by setting the tty-color-mode frame parameter. - (tty-register-default-colors)) + ;; terminal init file. We do this regardles of whether the terminal + ;; supports colors or not and regardless the current display type, + ;; since users can connect to color-capable terminals and also + ;; switch color support on or off in mid-session by setting the + ;; tty-color-mode frame parameter. + (tty-register-default-colors) ;; Record whether the tool-bar is present before the user and site ;; init files are processed. frame-notice-user-settings uses this @@ -1063,31 +1070,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (unless (or noninteractive - window-system - (null term-file-prefix)) - (let* ((TERM (getenv "TERM")) - (term TERM) - hyphend) - (while (and term - (not (load (concat term-file-prefix term) t t))) - ;; Strip off last hyphen and what follows, then try again - (setq term - (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) - (substring term 0 hyphend) - nil))) - (setq term TERM) - ;; The terminal file has been loaded, now call the terminal specific - ;; initialization function. - (while term - (let ((term-init-func (intern-soft (concat "terminal-init-" term)))) - (if (not (fboundp term-init-func)) - ;; Strip off last hyphen and what follows, then try again - (setq term - (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) - (substring term 0 hyphend) - nil)) - (setq term nil) - (funcall term-init-func)))))) + initial-window-system) + (tty-run-terminal-initialization (selected-frame))) ;; Update the out-of-memory error message based on user's key bindings ;; for save-some-buffers. @@ -1360,7 +1344,6 @@ Warning Warning!!! Pure space overflow !!!Warning Warning (force-mode-line-update) (setq fancy-current-text (cdr fancy-current-text)))) - (defun fancy-splash-default-action () "Stop displaying the splash screen buffer. This is an internal function used to turn off the splash screen after @@ -1370,20 +1353,23 @@ mouse." (if (and (memq 'down (event-modifiers last-command-event)) (eq (posn-window (event-start last-command-event)) (selected-window))) - ;; This is a mouse-down event in the spash screen window. + ;; This is a mouse-down event in the splash screen window. ;; Ignore it and consume the corresponding mouse-up event. (read-event) (push last-command-event unread-command-events)) (throw 'exit nil)) -(defun fancy-splash-special-event-action () - "Save the last event and stop displaying the splash screen buffer. -This is an internal function used to turn off the splash screen after -the user caused an input event that is bound in `special-event-map'" - (interactive) - (setq fancy-splash-last-input-event last-input-event) - (throw 'exit nil)) +(defun fancy-splash-exit () + "Exit the splash screen." + (if (get-buffer "GNU Emacs") + (throw 'stop-splashing nil))) +(defun fancy-splash-delete-frame (frame) + "Exit the splash screen after the frame is deleted." + ;; We can not throw from `delete-frame-events', so we set up a timer + ;; to exit the recursive edit as soon as Emacs is idle again. + (if (frame-live-p frame) + (run-at-time 0 nil 'fancy-splash-exit))) (defun fancy-splash-screens (&optional hide-on-input) "Display fancy splash screens when Emacs starts." @@ -1403,27 +1389,32 @@ the user caused an input event that is bound in `special-event-map'" (setq splash-buffer (current-buffer)) (catch 'stop-splashing (unwind-protect - (let ((map (make-sparse-keymap)) - (cursor-type nil)) - (use-local-map map) - (define-key map [switch-frame] 'ignore) + (let* ((map (make-sparse-keymap)) + (cursor-type nil) + (overriding-local-map map) + ;; Catch if our frame is deleted; the delete-frame + ;; event is unreliable and is handled by + ;; `special-event-map' anyway. + (delete-frame-functions (cons 'fancy-splash-delete-frame + delete-frame-functions))) (define-key map [t] 'fancy-splash-default-action) (define-key map [mouse-movement] 'ignore) (define-key map [mode-line t] 'ignore) - ;; Temporarily bind special events to - ;; fancy-splash-special-event-action so as to stop - ;; displaying splash screens with such events. - ;; Otherwise, drag-n-drop into splash screens may - ;; leave us in recursive editing with invisible - ;; cursors for a while. - (setq special-event-map (make-sparse-keymap)) - (map-keymap - (lambda (key def) - (define-key special-event-map (vector key) - (if (eq def 'ignore) - 'ignore - 'fancy-splash-special-event-action))) - old-special-event-map) + (define-key map [select-window] 'ignore) + ;; Temporarily bind special events to + ;; fancy-splash-special-event-action so as to stop + ;; displaying splash screens with such events. + ;; Otherwise, drag-n-drop into splash screens may + ;; leave us in recursive editing with invisible + ;; cursors for a while. + (setq special-event-map (make-sparse-keymap)) + (map-keymap + (lambda (key def) + (define-key special-event-map (vector key) + (if (eq def 'ignore) + 'ignore + 'fancy-splash-special-event-action))) + old-special-event-map) (setq display-hourglass nil minor-mode-map-alist nil emulation-mode-map-alists nil @@ -1443,12 +1434,15 @@ the user caused an input event that is bound in `special-event-map'" emulation-mode-map-alists old-emulation-mode-map-alists special-event-map old-special-event-map) (kill-buffer splash-buffer) + (when (frame-live-p frame) + (select-frame frame) + (switch-to-buffer fancy-splash-outer-buffer)) (when fancy-splash-last-input-event (setq last-input-event fancy-splash-last-input-event fancy-splash-last-input-event nil) - (command-execute (lookup-key special-event-map - (vector last-input-event)) - nil (vector last-input-event) t)))))) + (command-execute (lookup-key special-event-map + (vector last-input-event)) + nil (vector last-input-event) t)))))) ;; If hide-on-input is nil, don't hide the buffer on input. (if (or (window-minibuffer-p) (window-dedicated-p (selected-window))) @@ -1475,6 +1469,15 @@ Warning Warning!!! Pure space overflow !!!Warning Warning (view-mode-enter nil 'kill-buffer)) (goto-char (point-min))))) +(defun fancy-splash-special-event-action () + "Save the last event and stop displaying the splash screen buffer. +This is an internal function used to turn off the splash screen after +the user caused an input event that is bound in `special-event-map'" + (interactive) + (setq fancy-splash-last-input-event last-input-event) + (throw 'exit nil)) + + (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. Returning non-nil does not mean we should necessarily @@ -1565,89 +1568,89 @@ More Manuals / Ordering Manuals How to order printed manuals from the FSF (insert "\n\n" (emacs-version) "\n" emacs-copyright)) - ;; No mouse menus, so give help using kbd commands. - - ;; If keys have their default meanings, - ;; use precomputed string to save lots of time. - (if (and (eq (key-binding "\C-h") 'help-command) - (eq (key-binding "\C-xu") 'advertised-undo) - (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs) - (eq (key-binding "\C-ht") 'help-with-tutorial) - (eq (key-binding "\C-hi") 'info) - (eq (key-binding "\C-hr") 'info-emacs-manual) - (eq (key-binding "\C-h\C-n") 'view-emacs-news)) - (insert " + ;; No mouse menus, so give help using kbd commands. + + ;; If keys have their default meanings, + ;; use precomputed string to save lots of time. + (if (and (eq (key-binding "\C-h") 'help-command) + (eq (key-binding "\C-xu") 'advertised-undo) + (eq (key-binding "\C-x\C-c") 'save-buffers-kill-terminal) + (eq (key-binding "\C-ht") 'help-with-tutorial) + (eq (key-binding "\C-hi") 'info) + (eq (key-binding "\C-hr") 'info-emacs-manual) + (eq (key-binding "\C-h\C-n") 'view-emacs-news)) + (insert " Get help C-h (Hold down CTRL and press h) Emacs manual C-h r Emacs tutorial C-h t Undo changes C-x u Buy manuals C-h C-m Exit Emacs C-x C-c Browse manuals C-h i") - (insert (substitute-command-keys - (format "\n + (insert (substitute-command-keys + (format "\n Get help %s Emacs manual \\[info-emacs-manual] Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo] -Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs] +Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-terminal] Browse manuals \\[info]" - (let ((where (where-is-internal - 'help-command nil t))) - (if where - (key-description where) - "M-x help")))))) - - ;; Say how to use the menu bar with the keyboard. - (if (and (eq (key-binding "\M-`") 'tmm-menubar) - (eq (key-binding [f10]) 'tmm-menubar)) - (insert " + (let ((where (where-is-internal + 'help-command nil t))) + (if where + (key-description where) + "M-x help")))))) + + ;; Say how to use the menu bar with the keyboard. + (if (and (eq (key-binding "\M-`") 'tmm-menubar) + (eq (key-binding [f10]) 'tmm-menubar)) + (insert " Activate menubar F10 or ESC ` or M-`") - (insert (substitute-command-keys " + (insert (substitute-command-keys " Activate menubar \\[tmm-menubar]"))) - ;; Many users seem to have problems with these. - (insert " + ;; Many users seem to have problems with these. + (insert " \(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key. If you have no Meta key, you may instead type ESC followed by the character.)") (insert "\n\n" (emacs-version) "\n" emacs-copyright) - (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) - (eq (key-binding "\C-h\C-d") 'describe-distribution) - (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) - (insert - "\n + (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) + (eq (key-binding "\C-h\C-d") 'describe-distribution) + (eq (key-binding "\C-h\C-w") 'describe-no-warranty)) + (insert + "\n GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details. Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type C-h C-c to see the conditions. Type C-h C-d for information on getting the latest version.") - (insert (substitute-command-keys - "\n + (insert (substitute-command-keys + "\n GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details. Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type \\[describe-copying] to see the conditions. Type \\[describe-distribution] for information on getting the latest version.")))) - ;; The rest of the startup screen is the same on all - ;; kinds of terminals. - - ;; Give information on recovering, if there was a crash. - (and auto-save-list-file-prefix - ;; Don't signal an error if the - ;; directory for auto-save-list files - ;; does not yet exist. - (file-directory-p (file-name-directory - auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote (file-name-nondirectory - auto-save-list-file-prefix))) - t) - (insert "\n\nIf an Emacs session crashed recently, " - "type Meta-x recover-session RET\nto recover" - " the files you were editing.")) + ;; The rest of the startup screen is the same on all + ;; kinds of terminals. + + ;; Give information on recovering, if there was a crash. + (and auto-save-list-file-prefix + ;; Don't signal an error if the + ;; directory for auto-save-list files + ;; does not yet exist. + (file-directory-p (file-name-directory + auto-save-list-file-prefix)) + (directory-files + (file-name-directory auto-save-list-file-prefix) + nil + (concat "\\`" + (regexp-quote (file-name-nondirectory + auto-save-list-file-prefix))) + t) + (insert "\n\nIf an Emacs session crashed recently, " + "type Meta-x recover-session RET\nto recover" + " the files you were editing.")) ;; Display the input that we set up in the buffer. (set-buffer-modified-p nil) @@ -1655,20 +1658,18 @@ Type \\[describe-distribution] for information on getting the latest version.")) (if (and view-read-only (not view-mode)) (view-mode-enter nil 'kill-buffer)) (goto-char (point-min)) - (if hide-on-input - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - ;; If hide-on-input is nil, creating a new frame will - ;; generate enough events that the subsequent `sit-for' - ;; will immediately return anyway. - nil ;; (pop-to-buffer (current-buffer)) + (if hide-on-input + (if (or (window-minibuffer-p) + (window-dedicated-p (selected-window))) + ;; If hide-on-input is nil, creating a new frame will + ;; generate enough events that the subsequent `sit-for' + ;; will immediately return anyway. + nil ;; (pop-to-buffer (current-buffer)) (save-window-excursion - (switch-to-buffer (current-buffer)) - (sit-for 120))) - (condition-case nil - (switch-to-buffer (current-buffer)) - ;; In case the window is dedicated or something. - (error (pop-to-buffer (current-buffer)))))) + (switch-to-buffer (current-buffer)) + (sit-for 120)) + (condition-case nil + (switch-to-buffer (current-buffer)))))) ;; Unwind ... ensure splash buffer is killed (if hide-on-input (kill-buffer "GNU Emacs") @@ -1686,7 +1687,45 @@ Type \\[describe-distribution] for information on getting the latest version.")) (defun display-startup-echo-area-message () (let ((resize-mini-windows t)) - (message "%s" (startup-echo-area-message)))) + (or noninteractive ;(input-pending-p) init-file-had-error + ;; t if the init file says to inhibit the echo area startup message. + (and inhibit-startup-echo-area-message + user-init-file + (or (and (get 'inhibit-startup-echo-area-message 'saved-value) + (equal inhibit-startup-echo-area-message + (if (equal init-file-user "") + (user-login-name) + init-file-user))) + ;; Wasn't set with custom; see if .emacs has a setq. + (let ((buffer (get-buffer-create " *temp*"))) + (prog1 + (condition-case nil + (save-excursion + (set-buffer buffer) + (insert-file-contents user-init-file) + (re-search-forward + (concat + "([ \t\n]*setq[ \t\n]+" + "inhibit-startup-echo-area-message[ \t\n]+" + (regexp-quote + (prin1-to-string + (if (equal init-file-user "") + (user-login-name) + init-file-user))) + "[ \t\n]*)") + nil t)) + (error nil)) + (kill-buffer buffer))))) + ;; display-splash-screen at the end of command-line-1 calls + ;; use-fancy-splash-screens-p. This can cause image.el to be + ;; loaded, putting "Loading image... done" in the echo area. + ;; This hides startup-echo-area-message. So + ;; use-fancy-splash-screens-p is called here simply to get the + ;; loading of image.el (if needed) out of the way before + ;; display-startup-echo-area-message runs. + (progn + (use-fancy-splash-screens-p) + (message "%s" (startup-echo-area-message)))))) (defun display-splash-screen (&optional hide-on-input) @@ -1695,51 +1734,14 @@ Fancy splash screens are used on graphic displays, normal otherwise. With a prefix argument, any user input hides the splash screen." (interactive "P") - (if (use-fancy-splash-screens-p) - (fancy-splash-screens hide-on-input) - (normal-splash-screen hide-on-input))) - + ;; Prevent recursive calls from server-process-filter. + (if (not (get-buffer "GNU Emacs")) + (if (use-fancy-splash-screens-p) + (fancy-splash-screens hide-on-input) + (normal-splash-screen hide-on-input)))) (defun command-line-1 (command-line-args-left) - (or noninteractive (input-pending-p) init-file-had-error - ;; t if the init file says to inhibit the echo area startup message. - (and inhibit-startup-echo-area-message - user-init-file - (or (and (get 'inhibit-startup-echo-area-message 'saved-value) - (equal inhibit-startup-echo-area-message - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - ;; Wasn't set with custom; see if .emacs has a setq. - (let ((buffer (get-buffer-create " *temp*"))) - (prog1 - (condition-case nil - (save-excursion - (set-buffer buffer) - (insert-file-contents user-init-file) - (re-search-forward - (concat - "([ \t\n]*setq[ \t\n]+" - "inhibit-startup-echo-area-message[ \t\n]+" - (regexp-quote - (prin1-to-string - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - "[ \t\n]*)") - nil t)) - (error nil)) - (kill-buffer buffer))))) - ;; display-splash-screen at the end of command-line-1 calls - ;; use-fancy-splash-screens-p. This can cause image.el to be - ;; loaded, putting "Loading image... done" in the echo area. - ;; This hides startup-echo-area-message. So - ;; use-fancy-splash-screens-p is called here simply to get the - ;; loading of image.el (if needed) out of the way before - ;; display-startup-echo-area-message runs. - (progn - (use-fancy-splash-screens-p) - (display-startup-echo-area-message))) + (display-startup-echo-area-message) ;; Delay 2 seconds after an init file error message ;; was displayed, so user can read it. diff --git a/lisp/subr.el b/lisp/subr.el index c8c693565fc..546f7ccbd43 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1629,7 +1629,7 @@ any other non-digit terminates the character code and is then used as input.")) ;; or C-q C-x might not return immediately since ESC or C-x might be ;; bound to some prefix in function-key-map or key-translation-map. (setq translated char) - (let ((translation (lookup-key function-key-map (vector char)))) + (let ((translation (lookup-key local-function-key-map (vector char)))) (if (arrayp translation) (setq translated (aref translation 0)))) (cond ((null translated)) @@ -2408,6 +2408,23 @@ See also `with-temp-buffer'." (if (window-live-p save-selected-window-window) (select-window save-selected-window-window 'norecord)))))) +(defmacro with-selected-frame (frame &rest body) + "Execute the forms in BODY with FRAME as the selected frame. +The value returned is the value of the last form in BODY. +See also `with-temp-buffer'." + (declare (indent 1) (debug t)) + (let ((old-frame (make-symbol "old-frame")) + (old-buffer (make-symbol "old-buffer"))) + `(let ((,old-frame (selected-frame)) + (,old-buffer (current-buffer))) + (unwind-protect + (progn (select-frame ,frame) + ,@body) + (if (frame-live-p ,old-frame) + (select-frame ,old-frame)) + (if (buffer-live-p ,old-buffer) + (set-buffer ,old-buffer)))))) + (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. diff --git a/lisp/talk.el b/lisp/talk.el index 8af1577ac37..a46eadc745c 100644 --- a/lisp/talk.el +++ b/lisp/talk.el @@ -46,17 +46,44 @@ Each element has the form (DISPLAY FRAME BUFFER).") ;; Add the new buffers to all talk frames. (talk-update-buffers)) -(defun talk-add-display (display) - (let* ((elt (assoc display talk-display-alist)) - (name (concat "*talk-" display "*")) - buffer frame) - (if (not (and elt (frame-live-p (setq frame (nth 1 elt))))) - (setq frame (make-frame-on-display display (list (cons 'name name))))) +;;;###autoload +(defun talk () + "Connect to the Emacs talk group from the current X display or tty frame." + (interactive) + (let ((type (frame-live-p (selected-frame))) + (display (frame-terminal (selected-frame)))) + (cond + ((eq type t) + (talk-add-display (selected-frame))) + ((eq type 'x) + (talk-add-display (frame-terminal (selected-frame)))) + (t + (error "Unknown frame type")))) + (talk-update-buffers)) + +(defun talk-add-display (frame) + (let* ((display (if (frame-live-p frame) + (frame-terminal frame) + frame)) + (elt (assoc display talk-display-alist)) + (name (concat "*talk-" (terminal-name display) "*")) + buffer) + (unless (frame-live-p frame) + (setq frame (make-frame-on-display display (list (cons 'name name))))) + (if (and elt (frame-live-p (nth 1 elt))) + (setq frame (nth 1 elt))) (if (not (and elt (buffer-name (get-buffer (setq buffer (nth 2 elt)))))) (setq buffer (get-buffer-create name))) + (add-to-list 'delete-frame-functions 'talk-handle-delete-frame) (setq talk-display-alist (cons (list display frame buffer) (delq elt talk-display-alist))))) +(defun talk-handle-delete-frame (frame) + (dolist (d talk-display-alist) + (when (eq (nth 1 d) frame) + (setq talk-display-alist (delq d talk-display-alist)) + (talk-update-buffers)))) + (defun talk-disconnect () "Disconnect this display from the Emacs talk group." (interactive) diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 8adb94c07ca..23dfd8e2b11 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -29,34 +29,34 @@ ;;; 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 - ) +(defun terminal-init-AT386 () + "Terminal initialization function for AT386." + (let ((AT386-keypad-map (lookup-key local-function-key-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 local-function-key-map "\eN" [27]) ; ALT map + )) ;;; arch-tag: abec1b03-582f-49f8-b8cb-e2fd52ea4bd7 ;;; AT386.el ends here diff --git a/lisp/term/README b/lisp/term/README index e1cfbf15901..e5fb2da83ad 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 2db2cd93d4d..fb13f48d6ba 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 2f193007051..a941a0399f3 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -26,306 +26,314 @@ ;;; 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 (make-sparse-keymap) + "Function key definitions for SGI xwsh and winterm apps.") + +(define-key iris-function-map "\e[120q" [S-escape]) +(define-key iris-function-map "\e[121q" [C-escape]) - (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 iris-function-map "\e[001q" [f1]) +(define-key iris-function-map "\e[013q" [S-f1]) +(define-key iris-function-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 iris-function-map "\e[002q" [f2]) +(define-key iris-function-map "\e[014q" [S-f2]) +(define-key iris-function-map "\e[026q" [C-f2]) +(define-key iris-function-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 iris-function-map "\e[003q" [f3]) +(define-key iris-function-map "\e[015q" [S-f3]) +(define-key iris-function-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 iris-function-map "\e[004q" [f4]) +(define-key iris-function-map "\e[016q" [S-f4]) +(define-key iris-function-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 iris-function-map "\e[005q" [f5]) +(define-key iris-function-map "\e[017q" [S-f5]) +(define-key iris-function-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 iris-function-map "\e[006q" [f6]) +(define-key iris-function-map "\e[018q" [S-f6]) +(define-key iris-function-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 iris-function-map "\e[007q" [f7]) +(define-key iris-function-map "\e[019q" [S-f7]) +(define-key iris-function-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 iris-function-map "\e[008q" [f8]) +(define-key iris-function-map "\e[020q" [S-f8]) +(define-key iris-function-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 iris-function-map "\e[009q" [f9]) +(define-key iris-function-map "\e[021q" [S-f9]) +(define-key iris-function-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 iris-function-map "\e[010q" [f10]) +(define-key iris-function-map "\e[022q" [S-f10]) +(define-key iris-function-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 iris-function-map "\e[011q" [f11]) +(define-key iris-function-map "\e[023q" [S-f11]) +(define-key iris-function-map "\e[035q" [C-f11]) +(define-key iris-function-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 iris-function-map "\e[012q" [f12]) +(define-key iris-function-map "\e[024q" [S-f12]) +(define-key iris-function-map "\e[036q" [C-f12]) +(define-key iris-function-map "\e[048q" [M-f12]) - (define-key function-key-map "\e[057q" [?\C-`]) - (define-key function-key-map "\e[115q" [?\M-`]) +(define-key iris-function-map "\e[057q" [?\C-`]) +(define-key iris-function-map "\e[115q" [?\M-`]) - (define-key function-key-map "\e[049q" [?\C-1]) - (define-key function-key-map "\e[058q" [?\M-1]) +(define-key iris-function-map "\e[049q" [?\C-1]) +(define-key iris-function-map "\e[058q" [?\M-1]) - (define-key function-key-map "\e[059q" [?\M-2]) +(define-key iris-function-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 iris-function-map "\e[050q" [?\C-3]) +(define-key iris-function-map "\e[060q" [?\M-3]) - (define-key function-key-map "\e[051q" [?\C-4]) - (define-key function-key-map "\e[061q" [?\M-4]) +(define-key iris-function-map "\e[051q" [?\C-4]) +(define-key iris-function-map "\e[061q" [?\M-4]) - (define-key function-key-map "\e[052q" [?\C-5]) - (define-key function-key-map "\e[062q" [?\M-5]) +(define-key iris-function-map "\e[052q" [?\C-5]) +(define-key iris-function-map "\e[062q" [?\M-5]) - (define-key function-key-map "\e[063q" [?\M-6]) +(define-key iris-function-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 iris-function-map "\e[053q" [?\C-7]) +(define-key iris-function-map "\e[064q" [?\M-7]) - (define-key function-key-map "\e[054q" [?\C-8]) - (define-key function-key-map "\e[065q" [?\M-8]) +(define-key iris-function-map "\e[054q" [?\C-8]) +(define-key iris-function-map "\e[065q" [?\M-8]) - (define-key function-key-map "\e[055q" [?\C-9]) - (define-key function-key-map "\e[066q" [?\M-9]) +(define-key iris-function-map "\e[055q" [?\C-9]) +(define-key iris-function-map "\e[066q" [?\M-9]) - (define-key function-key-map "\e[056q" [?\C-0]) - (define-key function-key-map "\e[067q" [?\M-0]) +(define-key iris-function-map "\e[056q" [?\C-0]) +(define-key iris-function-map "\e[067q" [?\M-0]) - (define-key function-key-map "\e[068q" [?\M--]) +(define-key iris-function-map "\e[068q" [?\M--]) - (define-key function-key-map "\e[069q" [?\C-=]) - (define-key function-key-map "\e[070q" [?\M-=]) +(define-key iris-function-map "\e[069q" [?\C-=]) +(define-key iris-function-map "\e[070q" [?\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>]) +;; I don't know what to do with those. +;;(define-key iris-function-map "^H" [<del>]) +;;(define-key iris-function-map "^H" [S-<del>]) +;;(define-key iris-function-map "\177" [C-<del>]) +;;(define-key iris-function-map "\e[071q" [M-<del>]) - (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]) +(define-key iris-function-map "\e[Z" [?\S-\t]) +(define-key iris-function-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 iris-function-map "\e[073q" [?\M-\t]) - (define-key function-key-map "\e[074q" [?\M-q]) +(define-key iris-function-map "\e[074q" [?\M-q]) - (define-key function-key-map "\e[075q" [?\M-w]) +(define-key iris-function-map "\e[075q" [?\M-w]) - (define-key function-key-map "\e[076q" [?\M-e]) +(define-key iris-function-map "\e[076q" [?\M-e]) - (define-key function-key-map "\e[077q" [?\M-r]) +(define-key iris-function-map "\e[077q" [?\M-r]) - (define-key function-key-map "\e[078q" [?\M-t]) +(define-key iris-function-map "\e[078q" [?\M-t]) - (define-key function-key-map "\e[079q" [?\M-y]) +(define-key iris-function-map "\e[079q" [?\M-y]) - (define-key function-key-map "\e[080q" [?\M-u]) +(define-key iris-function-map "\e[080q" [?\M-u]) - (define-key function-key-map "\e[081q" [?\M-i]) +(define-key iris-function-map "\e[081q" [?\M-i]) - (define-key function-key-map "\e[082q" [?\M-o]) +(define-key iris-function-map "\e[082q" [?\M-o]) - (define-key function-key-map "\e[083q" [?\M-p]) +(define-key iris-function-map "\e[083q" [?\M-p]) - (define-key function-key-map "\e[084q" [?\M-\[]) +(define-key iris-function-map "\e[084q" [?\M-\[]) - (define-key function-key-map "\e[085q" [?\M-\]]) +(define-key iris-function-map "\e[085q" [?\M-\]]) - (define-key function-key-map "\e[086q" [?\M-\\]) +(define-key iris-function-map "\e[086q" [?\M-\\]) - (define-key function-key-map "\e[087q" [?\M-a]) +(define-key iris-function-map "\e[087q" [?\M-a]) - (define-key function-key-map "\e[088q" [?\M-s]) +(define-key iris-function-map "\e[088q" [?\M-s]) - (define-key function-key-map "\e[089q" [?\M-d]) +(define-key iris-function-map "\e[089q" [?\M-d]) - (define-key function-key-map "\e[090q" [?\M-f]) +(define-key iris-function-map "\e[090q" [?\M-f]) - (define-key function-key-map "\e[091q" [?\M-g]) +(define-key iris-function-map "\e[091q" [?\M-g]) - (define-key function-key-map "\e[092q" [?\M-h]) +(define-key iris-function-map "\e[092q" [?\M-h]) - (define-key function-key-map "\e[093q" [?\M-j]) +(define-key iris-function-map "\e[093q" [?\M-j]) - (define-key function-key-map "\e[094q" [?\M-k]) +(define-key iris-function-map "\e[094q" [?\M-k]) - (define-key function-key-map "\e[095q" [?\M-l]) +(define-key iris-function-map "\e[095q" [?\M-l]) - (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 iris-function-map "\e[096q" [?\C-\;]) +(define-key iris-function-map "\e[097q" [?\M-:]) ;; we are cheating + ;; here, this is realy + ;; M-;, but M-: + ;; generates the same + ;; string and is more + ;; usefull. - (define-key function-key-map "\e[098q" [?\C-']) - (define-key function-key-map "\e[099q" [?\M-']) +(define-key iris-function-map "\e[098q" [?\C-']) +(define-key iris-function-map "\e[099q" [?\M-']) - (define-key function-key-map "\e[100q" [?\M-\n]) +(define-key iris-function-map "\e[100q" [?\M-\n]) - (define-key function-key-map "\e[101q" [?\M-z]) +(define-key iris-function-map "\e[101q" [?\M-z]) - (define-key function-key-map "\e[102q" [?\M-x]) +(define-key iris-function-map "\e[102q" [?\M-x]) - (define-key function-key-map "\e[103q" [?\M-c]) +(define-key iris-function-map "\e[103q" [?\M-c]) - (define-key function-key-map "\e[104q" [?\M-v]) +(define-key iris-function-map "\e[104q" [?\M-v]) - (define-key function-key-map "\e[105q" [?\M-b]) +(define-key iris-function-map "\e[105q" [?\M-b]) - (define-key function-key-map "\e[106q" [M-n]) +(define-key iris-function-map "\e[106q" [M-n]) - (define-key function-key-map "\e[107q" [M-m]) +(define-key iris-function-map "\e[107q" [M-m]) - (define-key function-key-map "\e[108q" [?\C-,]) - (define-key function-key-map "\e[109q" [?\M-,]) +(define-key iris-function-map "\e[108q" [?\C-,]) +(define-key iris-function-map "\e[109q" [?\M-,]) - (define-key function-key-map "\e[110q" [?\C-.]) - (define-key function-key-map "\e[111q" [?\M-.]) +(define-key iris-function-map "\e[110q" [?\C-.]) +(define-key iris-function-map "\e[111q" [?\M-.]) - (define-key function-key-map "\e[112q" [?\C-/]) - (define-key function-key-map "\e[113q" [?\M-/]) +(define-key iris-function-map "\e[112q" [?\C-/]) +(define-key iris-function-map "\e[113q" [?\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 iris-function-map "\e[139q" [insert]) +(define-key iris-function-map "\e[139q" [S-insert]) +(define-key iris-function-map "\e[140q" [C-insert]) +(define-key iris-function-map "\e[141q" [M-insert]) - (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 iris-function-map "\e[H" [home]) +(define-key iris-function-map "\e[143q" [S-home]) +(define-key iris-function-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 +(define-key iris-function-map "\e[150q" [prior]) +(define-key iris-function-map "\e[151q" [S-prior]) ;; those don't seem + ;; to generate ;; anything - (define-key function-key-map "\e[152q" [C-prior]) +(define-key iris-function-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 iris-function-map "^?" [delete]) ?? something else seems to take care of this. +(define-key iris-function-map "\e[P" [S-delete]) +(define-key iris-function-map "\e[142q" [C-delete]) +(define-key iris-function-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 iris-function-map "\e[146q" [end]) +(define-key iris-function-map "\e[147q" [S-end]) ;; those don't seem to + ;; generate anything +(define-key iris-function-map "\e[148q" [C-end]) - (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 iris-function-map "\e[154q" [next]) +(define-key iris-function-map "\e[155q" [S-next]) +(define-key iris-function-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 iris-function-map "\e[161q" [S-up]) +(define-key iris-function-map "\e[162q" [C-up]) +(define-key iris-function-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 iris-function-map "\e[158q" [S-left]) +(define-key iris-function-map "\e[159q" [C-left]) +(define-key iris-function-map "\e[160q" [M-left]) - (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 iris-function-map "\e[164q" [S-down]) +(define-key iris-function-map "\e[165q" [C-down]) +(define-key iris-function-map "\e[166q" [M-down]) - (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 iris-function-map "\e[167q" [S-right]) +(define-key iris-function-map "\e[168q" [C-right]) +(define-key iris-function-map "\e[169q" [M-right]) - ;; Keypad functions, most of those are untested. - (define-key function-key-map "\e[179q" [?\C-/]) - (define-key function-key-map "\e[180q" [?\M-/]) +;; Keypad functions, most of those are untested. +(define-key iris-function-map "\e[179q" [?\C-/]) +(define-key iris-function-map "\e[180q" [?\M-/]) - (define-key function-key-map "\e[187q" [?\C-*]) - (define-key function-key-map "\e[188q" [?\M-*]) +(define-key iris-function-map "\e[187q" [?\C-*]) +(define-key iris-function-map "\e[188q" [?\M-*]) - (define-key function-key-map "\e[198q" [?\C--]) - (define-key function-key-map "\e[199q" [?\M--]) +(define-key iris-function-map "\e[198q" [?\C--]) +(define-key iris-function-map "\e[199q" [?\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]) +;; Something else takes care of home, up, prior, down, left, right, next +;(define-key iris-function-map "\e[H" [home]) +(define-key iris-function-map "\e[172q" [C-home]) - ;;(define-key function-key-map "\e[A" [up]) - (define-key function-key-map "\e[182q" [C-up]) +;(define-key iris-function-map "\e[A" [up]) +(define-key iris-function-map "\e[182q" [C-up]) - ;;(define-key function-key-map "\e[150q" [prior]) - (define-key function-key-map "\e[190q" [C-prior]) +;(define-key iris-function-map "\e[150q" [prior]) +(define-key iris-function-map "\e[190q" [C-prior]) - (define-key function-key-map "\e[200q" [?\C-+]) - (define-key function-key-map "\e[201q" [?\M-+]) +(define-key iris-function-map "\e[200q" [?\C-+]) +(define-key iris-function-map "\e[201q" [?\M-+]) - ;;(define-key function-key-map "\e[D" [left]) - (define-key function-key-map "\e[174q" [C-left]) +;(define-key iris-function-map "\e[D" [left]) +(define-key iris-function-map "\e[174q" [C-left]) - (define-key function-key-map "\e[000q" [begin]) - (define-key function-key-map "\e[184q" [C-begin]) +(define-key iris-function-map "\e[000q" [begin]) +(define-key iris-function-map "\e[184q" [C-begin]) - ;;(define-key function-key-map "\e[C" [right]) - (define-key function-key-map "\e[192q" [C-right]) +;(define-key iris-function-map "\e[C" [right]) +(define-key iris-function-map "\e[192q" [C-right]) - ;;(define-key function-key-map "\e[146q" [end]) - (define-key function-key-map "\e[176q" [C-end]) +;(define-key iris-function-map "\e[146q" [end]) +(define-key iris-function-map "\e[176q" [C-end]) - ;;(define-key function-key-map "\e[B" [down]) - (define-key function-key-map "\e[186q" [C-down]) +;(define-key iris-function-map "\e[B" [down]) +(define-key iris-function-map "\e[186q" [C-down]) - ;;(define-key function-key-map "\e[154q" [next]) - (define-key function-key-map "\e[194q" [C-next]) +;(define-key iris-function-map "\e[154q" [next]) +(define-key iris-function-map "\e[194q" [C-next]) - (define-key function-key-map "\e[100q" [M-enter]) +(define-key iris-function-map "\e[100q" [M-enter]) - (define-key function-key-map "\e[139q" [insert]) - (define-key function-key-map "\e[178q" [C-inset]) +(define-key iris-function-map "\e[139q" [insert]) +(define-key iris-function-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 iris-function-map "\e[P" [delete]) +(define-key iris-function-map "\e[196q" [C-delete]) +(define-key iris-function-map "\e[197q" [M-delete]) + +(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 local-function-key-map)) + (set-keymap-parent local-function-key-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 84de5966a88..fdd8e2229ac 100644 --- a/lisp/term/linux.el +++ b/lisp/term/linux.el @@ -16,9 +16,8 @@ ;; 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..17ac3474ff0 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 local-function-key-map)) + (set-keymap-parent local-function-key-map m))) ;;; 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 3fb07dd004a..c2dcdd9c787 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) @@ -1062,22 +1062,25 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) +(defun x-setup-function-keys (frame) + "Setup Function Keys for mac." ;; 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]) +(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]) +) ;; These tell read-char how to convert ;; these special chars to ASCII. @@ -2281,34 +2284,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") @@ -2486,6 +2461,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 @@ -2592,50 +2649,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." @@ -2683,7 +2697,6 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") (mac-scroll-ignore-events) (scroll-up 1))) -) ;;;; Others @@ -2721,5 +2734,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 57d8fd6cb14..514f363314d 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 local-function-key-map "\eO"))) (if (not (keymapp news-fkey-prefix)) (error "What? Your news termcap/terminfo has no keycaps in it")) diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index 64c09e0e1bd..d0411161773 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -26,8 +26,95 @@ ;;; Code: +(defvar rxvt-function-map (make-sparse-keymap) + "Function key overrides for rxvt.") + +;; Set up function-key-map entries that termcap and terminfo don't know. +(define-key rxvt-function-map "\e[A" [up]) +(define-key rxvt-function-map "\e[B" [down]) +(define-key rxvt-function-map "\e[C" [right]) +(define-key rxvt-function-map "\e[D" [left]) +(define-key rxvt-function-map "\e[2~" [insert]) +(define-key rxvt-function-map "\e[3~" [delete]) +(define-key rxvt-function-map "\e[4~" [select]) +(define-key rxvt-function-map "\e[5~" [prior]) +(define-key rxvt-function-map "\e[6~" [next]) +(define-key rxvt-function-map "\e[7~" [home]) +(define-key rxvt-function-map "\e[8~" [end]) +(define-key rxvt-function-map "\e[11~" [f1]) +(define-key rxvt-function-map "\e[12~" [f2]) +(define-key rxvt-function-map "\e[13~" [f3]) +(define-key rxvt-function-map "\e[14~" [f4]) +(define-key rxvt-function-map "\e[15~" [f5]) +(define-key rxvt-function-map "\e[17~" [f6]) +(define-key rxvt-function-map "\e[18~" [f7]) +(define-key rxvt-function-map "\e[19~" [f8]) +(define-key rxvt-function-map "\e[20~" [f9]) +(define-key rxvt-function-map "\e[21~" [f10]) +;; The strings emitted by f11 and f12 are the same as the strings +;; emitted by S-f1 and S-f2, so don't define f11 and f12. +;; (define-key rxvt-function-map "\e[23~" [f11]) +;; (define-key rxvt-function-map "\e[24~" [f12]) +(define-key rxvt-function-map "\e[29~" [print]) + +(define-key rxvt-function-map "\e[11^" [C-f1]) +(define-key rxvt-function-map "\e[12^" [C-f2]) +(define-key rxvt-function-map "\e[13^" [C-f3]) +(define-key rxvt-function-map "\e[14^" [C-f4]) +(define-key rxvt-function-map "\e[15^" [C-f5]) +(define-key rxvt-function-map "\e[17^" [C-f6]) +(define-key rxvt-function-map "\e[18^" [C-f7]) +(define-key rxvt-function-map "\e[19^" [C-f8]) +(define-key rxvt-function-map "\e[20^" [C-f9]) +(define-key rxvt-function-map "\e[21^" [C-f10]) + +(define-key rxvt-function-map "\e[23~" [S-f1]) +(define-key rxvt-function-map "\e[24~" [S-f2]) +(define-key rxvt-function-map "\e[25~" [S-f3]) +(define-key rxvt-function-map "\e[26~" [S-f4]) +(define-key rxvt-function-map "\e[28~" [S-f5]) +(define-key rxvt-function-map "\e[29~" [S-f6]) +(define-key rxvt-function-map "\e[31~" [S-f7]) +(define-key rxvt-function-map "\e[32~" [S-f8]) +(define-key rxvt-function-map "\e[33~" [S-f9]) +(define-key rxvt-function-map "\e[34~" [S-f10]) + +(define-key rxvt-function-map "\e[23^" [C-S-f1]) +(define-key rxvt-function-map "\e[24^" [C-S-f2]) +(define-key rxvt-function-map "\e[25^" [C-S-f3]) +(define-key rxvt-function-map "\e[26^" [C-S-f4]) +(define-key rxvt-function-map "\e[28^" [C-S-f5]) +(define-key rxvt-function-map "\e[29^" [C-S-f6]) +(define-key rxvt-function-map "\e[31^" [C-S-f7]) +(define-key rxvt-function-map "\e[32^" [C-S-f8]) +(define-key rxvt-function-map "\e[33^" [C-S-f9]) +(define-key rxvt-function-map "\e[34^" [C-S-f10]) + +(define-key rxvt-function-map "\e[2^" [C-insert]) +(define-key rxvt-function-map "\e[3^" [C-delete]) +(define-key rxvt-function-map "\e[5^" [C-prior]) +(define-key rxvt-function-map "\e[6^" [C-next]) +(define-key rxvt-function-map "\e[7^" [C-home]) +(define-key rxvt-function-map "\e[8^" [C-end]) +(define-key rxvt-function-map "\eOd" [C-left]) +(define-key rxvt-function-map "\eOc" [C-right]) +(define-key rxvt-function-map "\eOa" [C-up]) +(define-key rxvt-function-map "\eOb" [C-down]) + +(define-key rxvt-function-map "\e[2;2~" [S-insert]) +(define-key rxvt-function-map "\e[3$" [S-delete]) +(define-key rxvt-function-map "\e[5$" [S-prior]) +(define-key rxvt-function-map "\e[6$" [S-next]) +(define-key rxvt-function-map "\e[7$" [S-home]) +(define-key rxvt-function-map "\e[8$" [S-end]) +(define-key rxvt-function-map "\e[d" [S-left]) +(define-key rxvt-function-map "\e[c" [S-right]) +(define-key rxvt-function-map "\e[a" [S-up]) +(define-key rxvt-function-map "\e[b" [S-down]) + (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 @@ -36,128 +123,45 @@ ;; 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 [f11] [S-f1] local-function-key-map) + (substitute-key-definition [f12] [S-f2] local-function-key-map) + (substitute-key-definition [f13] [S-f3] local-function-key-map) + (substitute-key-definition [f14] [S-f4] local-function-key-map) + (substitute-key-definition [f15] [S-f5] local-function-key-map) + (substitute-key-definition [f16] [S-f6] local-function-key-map) + (substitute-key-definition [f17] [S-f7] local-function-key-map) + (substitute-key-definition [f18] [S-f8] local-function-key-map) + (substitute-key-definition [f19] [S-f9] local-function-key-map) + (substitute-key-definition [f20] [S-f10] local-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 [f23] [C-f1] local-function-key-map) + (substitute-key-definition [f24] [C-f2] local-function-key-map) + (substitute-key-definition [f25] [C-f3] local-function-key-map) + (substitute-key-definition [f26] [C-f4] local-function-key-map) + (substitute-key-definition [f27] [C-f5] local-function-key-map) + (substitute-key-definition [f28] [C-f6] local-function-key-map) + (substitute-key-definition [f29] [C-f7] local-function-key-map) + (substitute-key-definition [f30] [C-f8] local-function-key-map) + (substitute-key-definition [f31] [C-f9] local-function-key-map) + (substitute-key-definition [f32] [C-f10] local-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) + (substitute-key-definition [f33] [C-S-f1] local-function-key-map) + (substitute-key-definition [f34] [C-S-f2] local-function-key-map) + (substitute-key-definition [f35] [C-S-f3] local-function-key-map) + (substitute-key-definition [f36] [C-S-f4] local-function-key-map) + (substitute-key-definition [f37] [C-S-f5] local-function-key-map) + (substitute-key-definition [f38] [C-S-f6] local-function-key-map) + (substitute-key-definition [f39] [C-S-f7] local-function-key-map) + (substitute-key-definition [f40] [C-S-f8] local-function-key-map) + (substitute-key-definition [f41] [C-S-f9] local-function-key-map) + (substitute-key-definition [f42] [C-S-f10] local-function-key-map) - ;; Set up function-key-map entries that termcap and terminfo don't know. - (let ((map (make-sparse-keymap))) - (define-key map "\e[A" [up]) - (define-key map "\e[B" [down]) - (define-key map "\e[C" [right]) - (define-key map "\e[D" [left]) - (define-key map "\e[2~" [insert]) - (define-key map "\e[3~" [delete]) - (define-key map "\e[4~" [select]) - (define-key map "\e[5~" [prior]) - (define-key map "\e[6~" [next]) - (define-key map "\e[7~" [home]) - (define-key map "\e[8~" [end]) - (define-key map "\e[11~" [f1]) - (define-key map "\e[12~" [f2]) - (define-key map "\e[13~" [f3]) - (define-key map "\e[14~" [f4]) - (define-key map "\e[15~" [f5]) - (define-key map "\e[17~" [f6]) - (define-key map "\e[18~" [f7]) - (define-key map "\e[19~" [f8]) - (define-key map "\e[20~" [f9]) - (define-key map "\e[21~" [f10]) - ;; The strings emitted by f11 and f12 are the same as the strings - ;; emitted by S-f1 and S-f2, so don't define f11 and f12. - ;; (define-key map "\e[23~" [f11]) - ;; (define-key map "\e[24~" [f12]) - (define-key map "\e[29~" [print]) - - (define-key map "\e[11^" [C-f1]) - (define-key map "\e[12^" [C-f2]) - (define-key map "\e[13^" [C-f3]) - (define-key map "\e[14^" [C-f4]) - (define-key map "\e[15^" [C-f5]) - (define-key map "\e[17^" [C-f6]) - (define-key map "\e[18^" [C-f7]) - (define-key map "\e[19^" [C-f8]) - (define-key map "\e[20^" [C-f9]) - (define-key map "\e[21^" [C-f10]) - - (define-key map "\e[23~" [S-f1]) - (define-key map "\e[24~" [S-f2]) - (define-key map "\e[25~" [S-f3]) - (define-key map "\e[26~" [S-f4]) - (define-key map "\e[28~" [S-f5]) - (define-key map "\e[29~" [S-f6]) - (define-key map "\e[31~" [S-f7]) - (define-key map "\e[32~" [S-f8]) - (define-key map "\e[33~" [S-f9]) - (define-key map "\e[34~" [S-f10]) - - (define-key map "\e[23^" [C-S-f1]) - (define-key map "\e[24^" [C-S-f2]) - (define-key map "\e[25^" [C-S-f3]) - (define-key map "\e[26^" [C-S-f4]) - (define-key map "\e[28^" [C-S-f5]) - (define-key map "\e[29^" [C-S-f6]) - (define-key map "\e[31^" [C-S-f7]) - (define-key map "\e[32^" [C-S-f8]) - (define-key map "\e[33^" [C-S-f9]) - (define-key map "\e[34^" [C-S-f10]) - - (define-key map "\e[2^" [C-insert]) - (define-key map "\e[3^" [C-delete]) - (define-key map "\e[5^" [C-prior]) - (define-key map "\e[6^" [C-next]) - (define-key map "\e[7^" [C-home]) - (define-key map "\e[8^" [C-end]) - (define-key map "\eOd" [C-left]) - (define-key map "\eOc" [C-right]) - (define-key map "\eOa" [C-up]) - (define-key map "\eOb" [C-down]) - - (define-key map "\e[2;2~" [S-insert]) - (define-key map "\e[3$" [S-delete]) - (define-key map "\e[5$" [S-prior]) - (define-key map "\e[6$" [S-next]) - (define-key map "\e[7$" [S-home]) - (define-key map "\e[8$" [S-end]) - (define-key map "\e[d" [S-left]) - (define-key map "\e[c" [S-right]) - (define-key map "\e[a" [S-up]) - (define-key map "\e[b" [S-down]) - - ;; 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)) + ;; 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 local-function-key-map)) + (set-keymap-parent local-function-key-map m)) ;; Initialize colors and background mode. (rxvt-register-default-colors) @@ -239,7 +243,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 +286,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 +299,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.el b/lisp/term/sun.el index c3dc773e26b..5743272d96a 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -150,7 +150,7 @@ (defun terminal-init-sun () "Terminal initialization function for sun." - (define-key function-key-map "\e[" sun-raw-prefix) + (define-key local-function-key-map "\e[" sun-raw-prefix) (define-key sun-raw-prefix "210z" [r3]) (define-key sun-raw-prefix "213z" [r6]) diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 4af21f08522..e127abc51a2 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -31,14 +31,14 @@ (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))) + (or (lookup-key local-function-key-map "\e[") + (define-key local-function-key-map "\e[" (make-keymap))) + ;; (or (lookup-key local-function-key-map "\eO") + ;; (define-key local-function-key-map "\eO" (make-keymap))) ;; Miscellaneous keys (mapcar (function (lambda (key-binding) - (define-key function-key-map + (define-key local-function-key-map (car key-binding) (nth 1 key-binding)))) '( ;; These are set up by termcap or terminfo @@ -54,7 +54,7 @@ ("\e[@" [insert]) ("\e[L" [insertline]) ("\e[M" [deleteline]) - ("\e[U" [next]) ;; actually the `page' key + ("\e[U" [next]) ;; actually the `page' key ;; These won't be set up by either ("\eOm" [kp-subtract]) @@ -87,22 +87,23 @@ ;; The numeric keypad keys. (let ((i 0)) (while (< i 10) - (define-key function-key-map + (define-key local-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 + (define-key local-function-key-map (format "\e?%c" (+ i ?a)) (vector (intern (format "f%d" (1+ i))))) - (define-key function-key-map + (define-key local-function-key-map (format "\e?%c" (+ i ?A)) (vector (intern (format "S-f%d" (1+ i))))) (setq i (1+ i)))) (tvi970-set-keypad-mode 1)) + ;;; Should keypad numbers send ordinary digits or distinct escape sequences? (defvar tvi970-keypad-numeric nil diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index b185a7bb02f..17627db8923 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..7e7b3281d92 100644 --- a/lisp/term/vt200.el +++ b/lisp/term/vt200.el @@ -1,12 +1,11 @@ ;; -*- 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..a63f9561a6d 100644 --- a/lisp/term/vt201.el +++ b/lisp/term/vt201.el @@ -2,10 +2,10 @@ ;; 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..b2b8fc944cf 100644 --- a/lisp/term/vt220.el +++ b/lisp/term/vt220.el @@ -2,10 +2,10 @@ ;; 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..cb26ebf4069 100644 --- a/lisp/term/vt240.el +++ b/lisp/term/vt240.el @@ -2,10 +2,10 @@ ;; 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..9a09ad5e8cb 100644 --- a/lisp/term/vt300.el +++ b/lisp/term/vt300.el @@ -1,9 +1,9 @@ ;; -*- 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..803d7286067 100644 --- a/lisp/term/vt320.el +++ b/lisp/term/vt320.el @@ -1,9 +1,9 @@ ;; -*- 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..f73f4660b94 100644 --- a/lisp/term/vt400.el +++ b/lisp/term/vt400.el @@ -1,9 +1,9 @@ ;; -*- 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 local-function-key-map "\e[23~" [?\e])) ;;; 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..e65ba1a61d5 100644 --- a/lisp/term/vt420.el +++ b/lisp/term/vt420.el @@ -1,9 +1,9 @@ ;; -*- 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 local-function-key-map "\e[23~" [?\e])) ;;; 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 dfe94aaf133..e2b88086eac 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) @@ -89,9 +89,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") @@ -1039,58 +1036,30 @@ 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)) + +(defun x-setup-function-keys (frame) + "Setup Function Keys for w32." + (with-selected-frame frame + (define-key local-function-key-map [f10] 'menu-bar-open) + + (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame + local-function-key-map global-map) + + (define-key local-function-key-map [S-tab] [backtab])) + (set-terminal-parameter frame 'x-setup-function-keys t)) -;;; 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,111 +1072,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) - ;; 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)))) + ;;; Enable Japanese fonts on Windows to be used by default. (set-fontset-font nil (make-char 'katakana-jisx0201) '("*" . "JISX0208-SJIS")) @@ -1256,5 +1124,115 @@ pop-up menu are unaffected by `w32-list-proportional-fonts')." (tiff "libtiff3.dll" "libtiff.dll") (gif "giflib4.dll" "libungif4.dll" "libungif.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) + ;; 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/wyse50.el b/lisp/term/wyse50.el index c0e4334f522..e241224c637 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -40,9 +40,9 @@ (defun terminal-init-wyse50 () "Terminal initialization function for wyse50." - (define-key function-key-map "\C-a" (make-keymap)) + (define-key local-function-key-map "\C-a" (make-keymap)) (mapcar (function (lambda (key-definition) - (define-key function-key-map + (define-key local-function-key-map (car key-definition) (nth 1 key-definition)))) '( ;; These might be set up by termcap and terminfo @@ -100,11 +100,11 @@ ("\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 + ("\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 )) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 43fc37c54b8..926356f49a8 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) @@ -1170,27 +1176,30 @@ 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]) +(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 + (define-key local-function-key-map [backspace] [127]) + (define-key local-function-key-map [delete] [127]) + (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]) + (define-key local-function-key-map [iso-lefttab] [backtab]) + (define-key local-function-key-map [S-iso-lefttab] [backtab])) + (set-terminal-parameter frame 'x-setup-function-keys t))) ;; These tell read-char how to convert ;; these special chars to ASCII. @@ -2393,168 +2402,169 @@ order until succeed.") (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))))) +(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 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-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))) -;; 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)) + +;;; 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)) + +(provide 'x-win) ;; 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)) - ;; 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 5eb1d8b4c70..22f83f2f96d 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -27,16 +27,309 @@ ;;; Code: +(defvar xterm-function-map (make-sparse-keymap) + "Function key map overrides for xterm.") + +;; xterm from X.org 6.8.2 uses these key definitions. +(define-key xterm-function-map "\eOP" [f1]) +(define-key xterm-function-map "\eOQ" [f2]) +(define-key xterm-function-map "\eOR" [f3]) +(define-key xterm-function-map "\eOS" [f4]) +(define-key xterm-function-map "\e[15~" [f5]) +(define-key xterm-function-map "\e[17~" [f6]) +(define-key xterm-function-map "\e[18~" [f7]) +(define-key xterm-function-map "\e[19~" [f8]) +(define-key xterm-function-map "\e[20~" [f9]) +(define-key xterm-function-map "\e[21~" [f10]) +(define-key xterm-function-map "\e[23~" [f11]) +(define-key xterm-function-map "\e[24~" [f12]) + +(define-key xterm-function-map "\eO2P" [S-f1]) +(define-key xterm-function-map "\eO2Q" [S-f2]) +(define-key xterm-function-map "\eO2R" [S-f3]) +(define-key xterm-function-map "\eO2S" [S-f4]) +(define-key xterm-function-map "\e[1;2P" [S-f1]) +(define-key xterm-function-map "\e[1;2Q" [S-f2]) +(define-key xterm-function-map "\e[1;2R" [S-f3]) +(define-key xterm-function-map "\e[1;2S" [S-f4]) +(define-key xterm-function-map "\e[15;2~" [S-f5]) +(define-key xterm-function-map "\e[17;2~" [S-f6]) +(define-key xterm-function-map "\e[18;2~" [S-f7]) +(define-key xterm-function-map "\e[19;2~" [S-f8]) +(define-key xterm-function-map "\e[20;2~" [S-f9]) +(define-key xterm-function-map "\e[21;2~" [S-f10]) +(define-key xterm-function-map "\e[23;2~" [S-f11]) +(define-key xterm-function-map "\e[24;2~" [S-f12]) + +(define-key xterm-function-map "\eO5P" [C-f1]) +(define-key xterm-function-map "\eO5Q" [C-f2]) +(define-key xterm-function-map "\eO5R" [C-f3]) +(define-key xterm-function-map "\eO5S" [C-f4]) +(define-key xterm-function-map "\e[15;5~" [C-f5]) +(define-key xterm-function-map "\e[17;5~" [C-f6]) +(define-key xterm-function-map "\e[18;5~" [C-f7]) +(define-key xterm-function-map "\e[19;5~" [C-f8]) +(define-key xterm-function-map "\e[20;5~" [C-f9]) +(define-key xterm-function-map "\e[21;5~" [C-f10]) +(define-key xterm-function-map "\e[23;5~" [C-f11]) +(define-key xterm-function-map "\e[24;5~" [C-f12]) + +(define-key xterm-function-map "\eO6P" [C-S-f1]) +(define-key xterm-function-map "\eO6Q" [C-S-f2]) +(define-key xterm-function-map "\eO6R" [C-S-f3]) +(define-key xterm-function-map "\eO6S" [C-S-f4]) +(define-key xterm-function-map "\e[15;6~" [C-S-f5]) +(define-key xterm-function-map "\e[17;6~" [C-S-f6]) +(define-key xterm-function-map "\e[18;6~" [C-S-f7]) +(define-key xterm-function-map "\e[19;6~" [C-S-f8]) +(define-key xterm-function-map "\e[20;6~" [C-S-f9]) +(define-key xterm-function-map "\e[21;6~" [C-S-f10]) +(define-key xterm-function-map "\e[23;6~" [C-S-f11]) +(define-key xterm-function-map "\e[24;6~" [C-S-f12]) + +(define-key xterm-function-map "\eO3P" [A-f1]) +(define-key xterm-function-map "\eO3Q" [A-f2]) +(define-key xterm-function-map "\eO3R" [A-f3]) +(define-key xterm-function-map "\eO3S" [A-f4]) +(define-key xterm-function-map "\e[15;3~" [A-f5]) +(define-key xterm-function-map "\e[17;3~" [A-f6]) +(define-key xterm-function-map "\e[18;3~" [A-f7]) +(define-key xterm-function-map "\e[19;3~" [A-f8]) +(define-key xterm-function-map "\e[20;3~" [A-f9]) +(define-key xterm-function-map "\e[21;3~" [A-f10]) +(define-key xterm-function-map "\e[23;3~" [A-f11]) +(define-key xterm-function-map "\e[24;3~" [A-f12]) + +(define-key xterm-function-map "\eOA" [up]) +(define-key xterm-function-map "\eOB" [down]) +(define-key xterm-function-map "\eOC" [right]) +(define-key xterm-function-map "\eOD" [left]) +(define-key xterm-function-map "\eOF" [end]) +(define-key xterm-function-map "\eOH" [home]) + +(define-key xterm-function-map "\e[1;2A" [S-up]) +(define-key xterm-function-map "\e[1;2B" [S-down]) +(define-key xterm-function-map "\e[1;2C" [S-right]) +(define-key xterm-function-map "\e[1;2D" [S-left]) +(define-key xterm-function-map "\e[1;2F" [S-end]) +(define-key xterm-function-map "\e[1;2H" [S-home]) + +(define-key xterm-function-map "\e[1;5A" [C-up]) +(define-key xterm-function-map "\e[1;5B" [C-down]) +(define-key xterm-function-map "\e[1;5C" [C-right]) +(define-key xterm-function-map "\e[1;5D" [C-left]) +(define-key xterm-function-map "\e[1;5F" [C-end]) +(define-key xterm-function-map "\e[1;5H" [C-home]) + +(define-key xterm-function-map "\e[1;6A" [C-S-up]) +(define-key xterm-function-map "\e[1;6B" [C-S-down]) +(define-key xterm-function-map "\e[1;6C" [C-S-right]) +(define-key xterm-function-map "\e[1;6D" [C-S-left]) +(define-key xterm-function-map "\e[1;6F" [C-S-end]) +(define-key xterm-function-map "\e[1;6H" [C-S-home]) + +(define-key xterm-function-map "\e[1;3A" [A-up]) +(define-key xterm-function-map "\e[1;3B" [A-down]) +(define-key xterm-function-map "\e[1;3C" [A-right]) +(define-key xterm-function-map "\e[1;3D" [A-left]) +(define-key xterm-function-map "\e[1;3F" [A-end]) +(define-key xterm-function-map "\e[1;3H" [A-home]) + +(define-key xterm-function-map "\e[2~" [insert]) +(define-key xterm-function-map "\e[3~" [delete]) +(define-key xterm-function-map "\e[5~" [prior]) +(define-key xterm-function-map "\e[6~" [next]) + +(define-key xterm-function-map "\e[2;2~" [S-insert]) +(define-key xterm-function-map "\e[3;2~" [S-delete]) +(define-key xterm-function-map "\e[5;2~" [S-prior]) +(define-key xterm-function-map "\e[6;2~" [S-next]) + +(define-key xterm-function-map "\e[2;5~" [C-insert]) +(define-key xterm-function-map "\e[3;5~" [C-delete]) +(define-key xterm-function-map "\e[5;5~" [C-prior]) +(define-key xterm-function-map "\e[6;5~" [C-next]) + +(define-key xterm-function-map "\e[2;6~" [C-S-insert]) +(define-key xterm-function-map "\e[3;6~" [C-S-delete]) +(define-key xterm-function-map "\e[5;6~" [C-S-prior]) +(define-key xterm-function-map "\e[6;6~" [C-S-next]) + +(define-key xterm-function-map "\e[2;3~" [A-insert]) +(define-key xterm-function-map "\e[3;3~" [A-delete]) +(define-key xterm-function-map "\e[5;3~" [A-prior]) +(define-key xterm-function-map "\e[6;3~" [A-next]) + +(define-key xterm-function-map "\e[4~" [select]) +(define-key xterm-function-map "\e[29~" [print]) + +(define-key xterm-function-map "\eOj" [kp-multiply]) +(define-key xterm-function-map "\eOk" [kp-add]) +(define-key xterm-function-map "\eOl" [kp-separator]) +(define-key xterm-function-map "\eOm" [kp-subtract]) +(define-key xterm-function-map "\eOo" [kp-divide]) +(define-key xterm-function-map "\eOp" [kp-0]) +(define-key xterm-function-map "\eOq" [kp-1]) +(define-key xterm-function-map "\eOr" [kp-2]) +(define-key xterm-function-map "\eOs" [kp-3]) +(define-key xterm-function-map "\eOt" [kp-4]) +(define-key xterm-function-map "\eOu" [kp-5]) +(define-key xterm-function-map "\eOv" [kp-6]) +(define-key xterm-function-map "\eOw" [kp-7]) +(define-key xterm-function-map "\eOx" [kp-8]) +(define-key xterm-function-map "\eOy" [kp-9]) + +;; These keys are available in xterm starting from version 216 +;; if the modifyOtherKeys resource is set to 1. + +(define-key xterm-function-map "\e[27;5;9~" [C-tab]) +(define-key xterm-function-map "\e[27;5;13~" [C-return]) +(define-key xterm-function-map "\e[27;5;39~" [?\C-\']) +(define-key xterm-function-map "\e[27;5;44~" [?\C-,]) +(define-key xterm-function-map "\e[27;5;45~" [?\C--]) +(define-key xterm-function-map "\e[27;5;46~" [?\C-.]) +(define-key xterm-function-map "\e[27;5;47~" [?\C-/]) +(define-key xterm-function-map "\e[27;5;48~" [?\C-0]) +(define-key xterm-function-map "\e[27;5;49~" [?\C-1]) +;; Not all C-DIGIT keys have a distinct binding. +(define-key xterm-function-map "\e[27;5;57~" [?\C-9]) +(define-key xterm-function-map "\e[27;5;59~" [?\C-\;]) +(define-key xterm-function-map "\e[27;5;61~" [?\C-=]) +(define-key xterm-function-map "\e[27;5;92~" [?\C-\\]) + +(define-key xterm-function-map "\e[27;6;33~" [?\C-!]) +(define-key xterm-function-map "\e[27;6;34~" [?\C-\"]) +(define-key xterm-function-map "\e[27;6;35~" [?\C-#]) +(define-key xterm-function-map "\e[27;6;36~" [?\C-$]) +(define-key xterm-function-map "\e[27;6;37~" [?\C-%]) +(define-key xterm-function-map "\e[27;6;38~" [?\C-&]) +(define-key xterm-function-map "\e[27;6;40~" [?\C-(]) +(define-key xterm-function-map "\e[27;6;41~" [?\C-)]) +(define-key xterm-function-map "\e[27;6;42~" [?\C-*]) +(define-key xterm-function-map "\e[27;6;43~" [?\C-+]) +(define-key xterm-function-map "\e[27;6;58~" [?\C-:]) +(define-key xterm-function-map "\e[27;6;60~" [?\C-<]) +(define-key xterm-function-map "\e[27;6;62~" [?\C->]) +(define-key xterm-function-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 xterm-function-map "\e[27;13;9~" [C-M-tab]) +(define-key xterm-function-map "\e[27;13;13~" [C-M-return]) + +(define-key xterm-function-map "\e[27;13;39~" [?\C-\M-\']) +(define-key xterm-function-map "\e[27;13;44~" [?\C-\M-,]) +(define-key xterm-function-map "\e[27;13;45~" [?\C-\M--]) +(define-key xterm-function-map "\e[27;13;46~" [?\C-\M-.]) +(define-key xterm-function-map "\e[27;13;47~" [?\C-\M-/]) +(define-key xterm-function-map "\e[27;13;48~" [?\C-\M-0]) +(define-key xterm-function-map "\e[27;13;49~" [?\C-\M-1]) +(define-key xterm-function-map "\e[27;13;50~" [?\C-\M-2]) +(define-key xterm-function-map "\e[27;13;51~" [?\C-\M-3]) +(define-key xterm-function-map "\e[27;13;52~" [?\C-\M-4]) +(define-key xterm-function-map "\e[27;13;53~" [?\C-\M-5]) +(define-key xterm-function-map "\e[27;13;54~" [?\C-\M-6]) +(define-key xterm-function-map "\e[27;13;55~" [?\C-\M-7]) +(define-key xterm-function-map "\e[27;13;56~" [?\C-\M-8]) +(define-key xterm-function-map "\e[27;13;57~" [?\C-\M-9]) +(define-key xterm-function-map "\e[27;13;59~" [?\C-\M-\;]) +(define-key xterm-function-map "\e[27;13;61~" [?\C-\M-=]) +(define-key xterm-function-map "\e[27;13;92~" [?\C-\M-\\]) + +(define-key xterm-function-map "\e[27;14;33~" [?\C-\M-!]) +(define-key xterm-function-map "\e[27;14;34~" [?\C-\M-\"]) +(define-key xterm-function-map "\e[27;14;35~" [?\C-\M-#]) +(define-key xterm-function-map "\e[27;14;36~" [?\C-\M-$]) +(define-key xterm-function-map "\e[27;14;37~" [?\C-\M-%]) +(define-key xterm-function-map "\e[27;14;38~" [?\C-\M-&]) +(define-key xterm-function-map "\e[27;14;40~" [?\C-\M-\(]) +(define-key xterm-function-map "\e[27;14;41~" [?\C-\M-\)]) +(define-key xterm-function-map "\e[27;14;42~" [?\C-\M-*]) +(define-key xterm-function-map "\e[27;14;43~" [?\C-\M-+]) +(define-key xterm-function-map "\e[27;14;58~" [?\C-\M-:]) +(define-key xterm-function-map "\e[27;14;60~" [?\C-\M-<]) +(define-key xterm-function-map "\e[27;14;62~" [?\C-\M->]) +(define-key xterm-function-map "\e[27;14;63~" [(control meta ??)]) + +(define-key xterm-function-map "\e[27;7;9~" [C-M-tab]) +(define-key xterm-function-map "\e[27;7;13~" [C-M-return]) + +(define-key xterm-function-map "\e[27;7;32~" [?\C-\M-\s]) +(define-key xterm-function-map "\e[27;7;39~" [?\C-\M-\']) +(define-key xterm-function-map "\e[27;7;44~" [?\C-\M-,]) +(define-key xterm-function-map "\e[27;7;45~" [?\C-\M--]) +(define-key xterm-function-map "\e[27;7;46~" [?\C-\M-.]) +(define-key xterm-function-map "\e[27;7;47~" [?\C-\M-/]) +(define-key xterm-function-map "\e[27;7;48~" [?\C-\M-0]) +(define-key xterm-function-map "\e[27;7;49~" [?\C-\M-1]) +(define-key xterm-function-map "\e[27;7;50~" [?\C-\M-2]) +(define-key xterm-function-map "\e[27;7;51~" [?\C-\M-3]) +(define-key xterm-function-map "\e[27;7;52~" [?\C-\M-4]) +(define-key xterm-function-map "\e[27;7;53~" [?\C-\M-5]) +(define-key xterm-function-map "\e[27;7;54~" [?\C-\M-6]) +(define-key xterm-function-map "\e[27;7;55~" [?\C-\M-7]) +(define-key xterm-function-map "\e[27;7;56~" [?\C-\M-8]) +(define-key xterm-function-map "\e[27;7;57~" [?\C-\M-9]) +(define-key xterm-function-map "\e[27;7;59~" [?\C-\M-\;]) +(define-key xterm-function-map "\e[27;7;61~" [?\C-\M-=]) +(define-key xterm-function-map "\e[27;7;92~" [?\C-\M-\\]) + +(define-key xterm-function-map "\e[27;8;33~" [?\C-\M-!]) +(define-key xterm-function-map "\e[27;8;34~" [?\C-\M-\"]) +(define-key xterm-function-map "\e[27;8;35~" [?\C-\M-#]) +(define-key xterm-function-map "\e[27;8;36~" [?\C-\M-$]) +(define-key xterm-function-map "\e[27;8;37~" [?\C-\M-%]) +(define-key xterm-function-map "\e[27;8;38~" [?\C-\M-&]) +(define-key xterm-function-map "\e[27;8;40~" [?\C-\M-\(]) +(define-key xterm-function-map "\e[27;8;41~" [?\C-\M-\)]) +(define-key xterm-function-map "\e[27;8;42~" [?\C-\M-*]) +(define-key xterm-function-map "\e[27;8;43~" [?\C-\M-+]) +(define-key xterm-function-map "\e[27;8;58~" [?\C-\M-:]) +(define-key xterm-function-map "\e[27;8;60~" [?\C-\M-<]) +(define-key xterm-function-map "\e[27;8;62~" [?\C-\M->]) +(define-key xterm-function-map "\e[27;8;63~" [(control meta ??)]) + +(define-key xterm-function-map "\e[27;2;9~" [S-tab]) +(define-key xterm-function-map "\e[27;2;13~" [S-return]) + +(define-key xterm-function-map "\e[27;6;9~" [C-S-tab]) +(define-key xterm-function-map "\e[27;6;13~" [C-S-return]) + +;; Other versions of xterm might emit these. +(define-key xterm-function-map "\e[A" [up]) +(define-key xterm-function-map "\e[B" [down]) +(define-key xterm-function-map "\e[C" [right]) +(define-key xterm-function-map "\e[D" [left]) +(define-key xterm-function-map "\e[1~" [home]) + +(define-key xterm-function-map "\e[1;2A" [S-up]) +(define-key xterm-function-map "\e[1;2B" [S-down]) +(define-key xterm-function-map "\e[1;2C" [S-right]) +(define-key xterm-function-map "\e[1;2D" [S-left]) +(define-key xterm-function-map "\e[1;2F" [S-end]) +(define-key xterm-function-map "\e[1;2H" [S-home]) + +(define-key xterm-function-map "\e[1;5A" [C-up]) +(define-key xterm-function-map "\e[1;5B" [C-down]) +(define-key xterm-function-map "\e[1;5C" [C-right]) +(define-key xterm-function-map "\e[1;5D" [C-left]) +(define-key xterm-function-map "\e[1;5F" [C-end]) +(define-key xterm-function-map "\e[1;5H" [C-home]) + +(define-key xterm-function-map "\e[11~" [f1]) +(define-key xterm-function-map "\e[12~" [f2]) +(define-key xterm-function-map "\e[13~" [f3]) +(define-key xterm-function-map "\e[14~" [f4]) + (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)) + (if (and (getenv "COLORTERM" (selected-frame)) + (string-match "\\`rxvt" (getenv "COLORTERM" (selected-frame)))) + (tty-run-terminal-initialization (selected-frame) "rxvt") ;; The terminal intialization C code file might have initialized ;; function keys F13->F60 from the termcap/terminfo information. On @@ -46,358 +339,66 @@ ;; 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 "\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;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;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;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;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]) + (substitute-key-definition [f13] [S-f1] local-function-key-map) + (substitute-key-definition [f14] [S-f2] local-function-key-map) + (substitute-key-definition [f15] [S-f3] local-function-key-map) + (substitute-key-definition [f16] [S-f4] local-function-key-map) + (substitute-key-definition [f17] [S-f5] local-function-key-map) + (substitute-key-definition [f18] [S-f6] local-function-key-map) + (substitute-key-definition [f19] [S-f7] local-function-key-map) + (substitute-key-definition [f20] [S-f8] local-function-key-map) + (substitute-key-definition [f21] [S-f9] local-function-key-map) + (substitute-key-definition [f22] [S-f10] local-function-key-map) + (substitute-key-definition [f23] [S-f11] local-function-key-map) + (substitute-key-definition [f24] [S-f12] local-function-key-map) + + (substitute-key-definition [f25] [C-f1] local-function-key-map) + (substitute-key-definition [f26] [C-f2] local-function-key-map) + (substitute-key-definition [f27] [C-f3] local-function-key-map) + (substitute-key-definition [f28] [C-f4] local-function-key-map) + (substitute-key-definition [f29] [C-f5] local-function-key-map) + (substitute-key-definition [f30] [C-f6] local-function-key-map) + (substitute-key-definition [f31] [C-f7] local-function-key-map) + (substitute-key-definition [f32] [C-f8] local-function-key-map) + (substitute-key-definition [f33] [C-f9] local-function-key-map) + (substitute-key-definition [f34] [C-f10] local-function-key-map) + (substitute-key-definition [f35] [C-f11] local-function-key-map) + (substitute-key-definition [f36] [C-f12] local-function-key-map) + + (substitute-key-definition [f37] [C-S-f1] local-function-key-map) + (substitute-key-definition [f38] [C-S-f2] local-function-key-map) + (substitute-key-definition [f39] [C-S-f3] local-function-key-map) + (substitute-key-definition [f40] [C-S-f4] local-function-key-map) + (substitute-key-definition [f41] [C-S-f5] local-function-key-map) + (substitute-key-definition [f42] [C-S-f6] local-function-key-map) + (substitute-key-definition [f43] [C-S-f7] local-function-key-map) + (substitute-key-definition [f44] [C-S-f8] local-function-key-map) + (substitute-key-definition [f45] [C-S-f9] local-function-key-map) + (substitute-key-definition [f46] [C-S-f10] local-function-key-map) + (substitute-key-definition [f47] [C-S-f11] local-function-key-map) + (substitute-key-definition [f48] [C-S-f12] local-function-key-map) + + (substitute-key-definition [f49] [A-f1] local-function-key-map) + (substitute-key-definition [f50] [A-f2] local-function-key-map) + (substitute-key-definition [f51] [A-f3] local-function-key-map) + (substitute-key-definition [f52] [A-f4] local-function-key-map) + (substitute-key-definition [f53] [A-f5] local-function-key-map) + (substitute-key-definition [f54] [A-f6] local-function-key-map) + (substitute-key-definition [f55] [A-f7] local-function-key-map) + (substitute-key-definition [f56] [A-f8] local-function-key-map) + (substitute-key-definition [f57] [A-f9] local-function-key-map) + (substitute-key-definition [f58] [A-f10] local-function-key-map) + (substitute-key-definition [f59] [A-f11] local-function-key-map) + (substitute-key-definition [f60] [A-f12] local-function-key-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 local-function-key-map)) + (set-keymap-parent local-function-key-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) @@ -430,7 +431,7 @@ (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-turn-off-modify-other-keys) - (xterm-turn-on-modify-other-keys)))))))) + (xterm-turn-on-modify-other-keys))))))) ;; Set up colors, for those versions of xterm that support it. (defvar xterm-standard-colors @@ -467,7 +468,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) diff --git a/lisp/termdev.el b/lisp/termdev.el new file mode 100644 index 00000000000..c73fe017046 --- /dev/null +++ b/lisp/termdev.el @@ -0,0 +1,195 @@ +;;; termdev.el --- functions for dealing with terminals + +;; Copyright (C) 2005 Free Software Foundation, Inc. + +;; Author: Karoly Lorentey <karoly@lorentey.hu> +;; Created: 2005-12-22 +;; Keywords: internal + +;; 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 2, 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. + +(substitute-key-definition 'suspend-emacs 'suspend-frame global-map) + +(defun terminal-id (&optional terminal) + "Return the numerical id of terminal TERMINAL. + +TERMINAL can be a terminal id (an integer), a frame, or +nil (meaning the selected frame's terminal). Alternatively, +TERMINAL may be the name of an X display +device (HOST.SERVER.SCREEN) or a tty device file." + (cond + ((integerp terminal) + (if (terminal-live-p terminal) + terminal + (signal 'wrong-type-argument (list 'terminal-live-p terminal)))) + ((or (null terminal) (framep terminal)) + (frame-terminal terminal)) + ((stringp terminal) + (let ((f (car (filtered-frame-list (lambda (frame) + (or (equal (frame-parameter frame 'display) terminal) + (equal (frame-parameter frame 'tty) terminal))))))) + (or f (error "Display %s does not exist" terminal)) + (frame-terminal f))) + (t + (error "Invalid argument %s in `terminal-id'" terminal)))) + +;; (defun terminal-getenv (variable &optional terminal global-ok) +;; "Get the value of VARIABLE in the client environment of TERMINAL. +;; VARIABLE should be a string. Value is nil if VARIABLE is undefined in +;; the environment. Otherwise, value is a string. + +;; If TERMINAL has an associated emacsclient process, then +;; `terminal-getenv' looks up VARIABLE in the environment of that +;; process; otherwise the function consults the global environment, +;; i.e., the environment of the Emacs process itself. + +;; If GLOBAL-OK is non-nil, and VARIABLE is not defined in the +;; terminal-local environment, then `terminal-getenv' will return +;; its value in the global environment instead. + +;; TERMINAL can be a terminal id, a frame, or nil (meaning the +;; selected frame's terminal)." +;; (setq terminal (terminal-id terminal)) +;; (if (null (terminal-parameter terminal 'environment)) +;; (getenv variable) +;; (if (multibyte-string-p variable) +;; (setq variable (encode-coding-string variable locale-coding-system))) +;; (let ((env (terminal-parameter terminal 'environment)) +;; result entry) +;; (while (and env (null result)) +;; (setq entry (car env) +;; env (cdr env)) +;; (if (and (> (length entry) (length variable)) +;; (eq ?= (aref entry (length variable))) +;; (equal variable (substring entry 0 (length variable)))) +;; (setq result (substring entry (+ (length variable) 1))))) +;; (if (and global-ok (null result)) +;; (getenv variable) +;; (and result (decode-coding-string result locale-coding-system)))))) + +;; (defun terminal-setenv (variable &optional value terminal) +;; "Set the value of VARIABLE in the environment of TERMINAL. +;; VARIABLE should be string. VALUE is optional; if not provided or +;; nil, the environment variable VARIABLE is removed. Returned +;; value is the new value of VARIABLE, or nil if it was removed from +;; the environment. + +;; If TERMINAL was created by an emacsclient invocation, then the +;; variable is set in the environment of the emacsclient process; +;; otherwise the function changes the environment of the Emacs +;; process itself. + +;; TERMINAL can be a terminal id, a frame, or nil (meaning the +;; selected frame's terminal)." +;; (if (null (terminal-parameter terminal 'environment)) +;; (setenv variable value) +;; (with-terminal-environment terminal variable +;; (setenv variable value)))) + +;; (defun terminal-setenv-internal (variable value terminal) +;; "Set the value of VARIABLE in the environment of TERMINAL. +;; The caller is responsible to ensure that both VARIABLE and VALUE +;; are usable in environment variables and that TERMINAL is a +;; remote terminal." +;; (if (multibyte-string-p variable) +;; (setq variable (encode-coding-string variable locale-coding-system))) +;; (if (and value (multibyte-string-p value)) +;; (setq value (encode-coding-string value locale-coding-system))) +;; (let ((env (terminal-parameter terminal 'environment)) +;; found) +;; (while (and env (not found)) +;; (if (and (> (length (car env)) (length variable)) +;; (eq ?= (aref (car env) (length variable))) +;; (equal variable (substring (car env) 0 (length variable)))) +;; (progn +;; (if value +;; (setcar env (concat variable "=" value)) +;; (set-terminal-parameter terminal 'environment +;; (delq (car env) +;; (terminal-parameter terminal +;; 'environment)))) +;; (setq found t)) +;; (setq env (cdr env)))) +;; (cond +;; ((and value found) +;; (setcar env (concat variable "=" value))) +;; ((and value (not found)) +;; (set-terminal-parameter terminal 'environment +;; (cons (concat variable "=" value) +;; (terminal-parameter terminal +;; 'environment)))) +;; ((and (not value) found) +;; (set-terminal-parameter terminal 'environment +;; (delq (car env) +;; (terminal-parameter terminal +;; 'environment))))))) + +;; (defmacro with-terminal-environment (terminal vars &rest body) +;; "Evaluate BODY with environment variables VARS set to those of TERMINAL. +;; The environment variables are then restored to their previous values. + +;; VARS should be a single string, a list of strings, or t for all +;; environment variables. + +;; TERMINAL can be a terminal id, a frame, or nil (meaning the +;; selected frame's terminal). + +;; If BODY uses `setenv' to change environment variables in VARS, +;; then the new variable values will be remembered for TERMINAL, and +;; `terminal-getenv' will return them even outside BODY." +;; (declare (indent 2)) +;; (let ((var (make-symbol "var")) +;; (term (make-symbol "term")) +;; (v (make-symbol "v")) +;; (old-env (make-symbol "old-env"))) +;; `(let ((,term ,terminal) ; Evaluate arguments only once. +;; (,v ,vars)) +;; (if (stringp ,v) +;; (setq ,v (list ,v))) +;; (cond +;; ((null (terminal-parameter ,term 'environment)) +;; ;; Not a remote terminal; nothing to do. +;; (progn ,@body)) +;; ((eq ,v t) +;; ;; Switch the entire process-environment. +;; (let (,old-env process-environment) +;; (setq process-environment (terminal-parameter ,term 'environment)) +;; (unwind-protect +;; (progn ,@body) +;; (set-terminal-parameter ,term 'environment process-environment) +;; (setq process-environment ,old-env)))) +;; (t +;; ;; Do only a set of variables. +;; (let (,old-env) +;; (dolist (,var ,v) +;; (setq ,old-env (cons (cons ,var (getenv ,var)) ,old-env)) +;; (setenv ,var (terminal-getenv ,var ,term))) +;; (unwind-protect +;; (progn ,@body) +;; ;; Split storing new values and restoring old ones so +;; ;; that we DTRT even if a variable is specified twice in +;; ;; VARS. +;; (dolist (,var ,v) +;; (terminal-setenv-internal ,var (getenv ,var) ,term)) +;; (dolist (,var ,old-env) +;; (setenv (car ,var) (cdr ,var)))))))))) + +(provide 'termdev) + +;;; arch-tag: 4c4df277-1ec1-4f56-bfde-7f156fe62fb2 +;;; termdev.el ends here diff --git a/lisp/tmm.el b/lisp/tmm.el index b6b5e46aa27..e4436fc68ff 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -47,7 +47,6 @@ (defvar tmm-table-undef) ;;;###autoload (define-key global-map "\M-`" 'tmm-menubar) -;;;###autoload (define-key global-map [f10] 'tmm-menubar) ;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) ;;;###autoload diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 768fee70411..e3635f47fe7 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -55,23 +55,23 @@ conveniently adding tool bar items." :group 'mouse :group 'frames (and (display-images-p) - (let ((lines (if tool-bar-mode 1 0))) - ;; Alter existing frames... - (mapc (lambda (frame) - (modify-frame-parameters frame - (list (cons 'tool-bar-lines lines)))) - (frame-list)) - ;; ...and future ones. - (let ((elt (assq 'tool-bar-lines default-frame-alist))) - (if elt - (setcdr elt lines) - (add-to-list 'default-frame-alist (cons 'tool-bar-lines lines))))) + (modify-all-frames-parameters (list (cons 'tool-bar-lines + (if tool-bar-mode 1 0)))) (if (and tool-bar-mode - (display-graphic-p) - (= 1 (length (default-value 'tool-bar-map)))) ; not yet setup + (display-graphic-p)) (tool-bar-setup)))) ;;;###autoload +;; Used in the Show/Hide menu, to have the toggle reflect the current frame. +(defun toggle-tool-bar-mode-from-frame (&optional arg) + "Toggle tool bar on or off, based on the status of the current frame. +See `tool-bar-mode' for more information." + (interactive (list (or current-prefix-arg 'toggle))) + (if (eq arg 'toggle) + (tool-bar-mode (if (> (frame-parameter nil 'tool-bar-lines) 0) 0 1)) + (tool-bar-mode arg))) + +;;;###autoload ;; We want to pretend the toolbar by standard is on, as this will make ;; customize consider disabling the toolbar a customization, and save ;; that. We could do this for real by setting :init-value above, but @@ -228,42 +228,47 @@ holds a keymap." ;;; Set up some global items. Additions/deletions up for grabs. -(defun tool-bar-setup () - ;; People say it's bad to have EXIT on the tool bar, since users - ;; might inadvertently click that button. - ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") - (tool-bar-add-item-from-menu 'find-file "new") - (tool-bar-add-item-from-menu 'menu-find-file-existing "open") - (tool-bar-add-item-from-menu 'dired "diropen") - (tool-bar-add-item-from-menu 'kill-this-buffer "close") - (tool-bar-add-item-from-menu 'save-buffer "save" nil - :visible '(or buffer-file-name - (not (eq 'special - (get major-mode - 'mode-class))))) - (tool-bar-add-item-from-menu 'write-file "saveas" nil - :visible '(or buffer-file-name - (not (eq 'special - (get major-mode - 'mode-class))))) - (tool-bar-add-item-from-menu 'undo "undo" nil - :visible '(not (eq 'special (get major-mode - 'mode-class)))) - (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) - "cut" nil - :visible '(not (eq 'special (get major-mode - 'mode-class)))) - (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) - "copy") - (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) - "paste" nil - :visible '(not (eq 'special (get major-mode - 'mode-class)))) - (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") - ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") - - ;; There's no icon appropriate for News and we need a command rather - ;; than a lambda for Read Mail. +(defvar tool-bar-setup nil + "t if the tool-bar has been set up by `tool-bar-setup'.") + +(defun tool-bar-setup (&optional frame) + (unless tool-bar-setup + (with-selected-frame (or frame (selected-frame)) + ;; People say it's bad to have EXIT on the tool bar, since users + ;; might inadvertently click that button. + ;;(tool-bar-add-item-from-menu 'save-buffers-kill-emacs "exit") + (tool-bar-add-item-from-menu 'find-file "new") + (tool-bar-add-item-from-menu 'menu-find-file-existing "open") + (tool-bar-add-item-from-menu 'dired "diropen") + (tool-bar-add-item-from-menu 'kill-this-buffer "close") + (tool-bar-add-item-from-menu 'save-buffer "save" nil + :visible '(or buffer-file-name + (not (eq 'special + (get major-mode + 'mode-class))))) + (tool-bar-add-item-from-menu 'write-file "saveas" nil + :visible '(or buffer-file-name + (not (eq 'special + (get major-mode + 'mode-class))))) + (tool-bar-add-item-from-menu 'undo "undo" nil + :visible '(not (eq 'special (get major-mode + 'mode-class)))) + (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) + "cut" nil + :visible '(not (eq 'special (get major-mode + 'mode-class)))) + (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) + "copy") + (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) + "paste" nil + :visible '(not (eq 'special (get major-mode + 'mode-class)))) + (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") + ;;(tool-bar-add-item-from-menu 'ispell-buffer "spell") + + ;; There's no icon appropriate for News and we need a command rather + ;; than a lambda for Read Mail. ;;(tool-bar-add-item-from-menu 'compose-mail "mail/compose") (tool-bar-add-item-from-menu 'print-buffer "print") @@ -281,9 +286,9 @@ holds a keymap." (popup-menu menu-bar-help-menu)) 'help :help "Pop up the Help menu")) - ) + (setq tool-bar-setup t)))) -(provide 'tool-bar) +(provide 'tool-bar) ;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f ;;; tool-bar.el ends here diff --git a/lisp/version.el b/lisp/version.el index 9b6f06f2eff..7fc93d363dc 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -30,7 +30,7 @@ (defconst emacs-copyright "Copyright (C) 2007 Free Software Foundation, Inc." "Short copyright string for this version of Emacs.") -(defconst emacs-version "22.1.50" "\ +(defconst emacs-version "23.0.51" "\ Version numbers of this version of Emacs.") (defconst emacs-major-version @@ -58,8 +58,8 @@ to the system configuration; look at `system-configuration' instead." (interactive "P") (let ((version-string (format (if (not (interactive-p)) - "GNU Emacs %s (%s%s%s)\n of %s on %s" - "GNU Emacs %s (%s%s%s) of %s on %s") + "GNU Emacs %s (%s%s%s%s)\n of %s on %s" + "GNU Emacs %s (%s%s%s%s) of %s on %s") emacs-version system-configuration (cond ((featurep 'motif) @@ -75,6 +75,7 @@ to the system configuration; look at `system-configuration' instead." (format ", %s scroll bars" (capitalize (symbol-name x-toolkit-scroll-bars))) "") + (if (featurep 'multi-tty) ", multi-tty" "") (format-time-string "%Y-%m-%d" emacs-build-time) emacs-build-system))) (if here diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 1c29669b73b..f6f3b75dc07 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -121,14 +121,15 @@ any protocol specific data.") (defun x-dnd-init-frame (&optional frame) "Setup drag and drop for FRAME (i.e. create appropriate properties)." - (x-register-dnd-atom "DndProtocol" frame) - (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame) - (x-register-dnd-atom "XdndEnter" frame) - (x-register-dnd-atom "XdndPosition" frame) - (x-register-dnd-atom "XdndLeave" frame) - (x-register-dnd-atom "XdndDrop" frame) - (x-dnd-init-xdnd-for-frame frame) - (x-dnd-init-motif-for-frame frame)) + (when (eq 'x (window-system frame)) + (x-register-dnd-atom "DndProtocol" frame) + (x-register-dnd-atom "_MOTIF_DRAG_AND_DROP_MESSAGE" frame) + (x-register-dnd-atom "XdndEnter" frame) + (x-register-dnd-atom "XdndPosition" frame) + (x-register-dnd-atom "XdndLeave" frame) + (x-register-dnd-atom "XdndDrop" frame) + (x-dnd-init-xdnd-for-frame frame) + (x-dnd-init-motif-for-frame frame))) (defun x-dnd-get-state-cons-for-frame (frame-or-window) "Return the entry in x-dnd-current-state for a frame or window." diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index bf4eeab2259..cefce2f62e7 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -45,6 +45,7 @@ (defvar xterm-mouse-debug-buffer nil) +;; XXX Perhaps this should be terminal-local instead. --lorentey (define-key function-key-map "\e[M" 'xterm-mouse-translate) (defvar xterm-mouse-last) @@ -104,11 +105,13 @@ (vector (list down-where down-data) down) (vector down)))))))) -(defvar xterm-mouse-x 0 - "Position of last xterm mouse event relative to the frame.") - -(defvar xterm-mouse-y 0 - "Position of last xterm mouse event relative to the frame.") +;; These two variables have been converted to terminal parameters. +;; +;;(defvar xterm-mouse-x 0 +;; "Position of last xterm mouse event relative to the frame.") +;; +;;(defvar xterm-mouse-y 0 +;; "Position of last xterm mouse event relative to the frame.") (defvar xt-mouse-epoch nil) @@ -116,7 +119,9 @@ (defun xterm-mouse-position-function (pos) "Bound to `mouse-position-function' in XTerm mouse mode." - (setcdr pos (cons xterm-mouse-x xterm-mouse-y)) + (when (terminal-parameter nil 'xterm-mouse-x) + (setcdr pos (cons (terminal-parameter nil 'xterm-mouse-x) + (terminal-parameter nil 'xterm-mouse-y)))) pos) ;; read xterm sequences above ascii 127 (#x7f) @@ -175,8 +180,8 @@ (left (nth 0 ltrb)) (top (nth 1 ltrb))) - (setq xterm-mouse-x x - xterm-mouse-y y) + (set-terminal-parameter nil 'xterm-mouse-x x) + (set-terminal-parameter nil 'xterm-mouse-y y) (setq last-input-event (list mouse @@ -201,7 +206,7 @@ down the SHIFT key while pressing the mouse button." :global t :group 'mouse (if xterm-mouse-mode ;; Turn it on - (unless window-system + (progn (setq mouse-position-function #'xterm-mouse-position-function) (turn-on-xterm-mouse-tracking)) ;; Turn it off @@ -210,15 +215,43 @@ down the SHIFT key while pressing the mouse button." (defun turn-on-xterm-mouse-tracking () "Enable Emacs mouse tracking in xterm." - (if xterm-mouse-mode - (send-string-to-terminal "\e[?1000h"))) + (dolist (f (frame-list)) + (when (eq t (frame-live-p f)) + (with-selected-frame f + (when xterm-mouse-mode + (send-string-to-terminal "\e[?1000h")))))) (defun turn-off-xterm-mouse-tracking (&optional force) "Disable Emacs mouse tracking in xterm." - (if (or force xterm-mouse-mode) - (send-string-to-terminal "\e[?1000l"))) + (dolist (f (frame-list)) + (when (eq t (frame-live-p f)) + (with-selected-frame f + (when (or force xterm-mouse-mode) + (send-string-to-terminal "\e[?1000l")))))) + +(defun turn-on-xterm-mouse-tracking-on-terminal (terminal) + "Enable xterm mouse tracking on TERMINAL." + (when (and xterm-mouse-mode (eq t (terminal-live-p terminal))) + (send-string-to-terminal "\e[?1000h" terminal))) + +(defun turn-off-xterm-mouse-tracking-on-terminal (terminal) + "Disable xterm mouse tracking on TERMINAL." + (when (and xterm-mouse-mode (eq t (terminal-live-p terminal))) + (send-string-to-terminal "\e[?1000l" terminal))) + +(defun xterm-mouse-handle-delete-frame (frame) + "Turn off xterm mouse tracking if FRAME is the last frame on its device." + (when (and (eq t (frame-live-p frame)) + (<= 1 (length (frames-on-display-list (frame-terminal frame))))) + (turn-off-xterm-mouse-tracking-on-terminal frame))) + +;; Frame creation and deletion. +(add-hook 'after-make-frame-functions 'turn-on-xterm-mouse-tracking-on-terminal) +(add-hook 'delete-frame-functions 'xterm-mouse-handle-delete-frame) ;; Restore normal mouse behaviour outside Emacs. +(add-hook 'suspend-tty-functions 'turn-off-xterm-mouse-tracking-on-terminal) +(add-hook 'resume-tty-functions 'turn-on-xterm-mouse-tracking-on-terminal) (add-hook 'suspend-hook 'turn-off-xterm-mouse-tracking) (add-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking) (add-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking) |