procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge multi-tty branch

Browse source 
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-866
This commit is contained in:
Miles Bader 2007-08-29 05:28:10 +00:00
commit 8d9cc0b7ea
152 changed files with 14568 additions and 6976 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
README
View file

@ -3,7 +3,7 @@ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
See the end of the file for license conditions.
This directory tree holds version 22.1.50 of GNU Emacs, the extensible,
This directory tree holds version 23.0.51 of GNU Emacs, the extensible,
customizable, self-documenting real-time display editor.
The file INSTALL in this directory says how to build and install GNU

1465
README.multi-tty Normal file
View file

File diff suppressed because it is too large Load diff

2
configure vendored
View file

@ -11450,7 +11450,6 @@ if test "${HAVE_GTK}" = "yes"; then
with_toolkit_scroll_bars=yes
fi
HAVE_GTK_MULTIDISPLAY=no
for ac_func in gdk_display_open
do
@ -11552,6 +11551,7 @@ cat >>confdefs.h <<\_ACEOF
_ACEOF
fi
HAVE_GTK_FILE_SELECTION=no
for ac_func in gtk_file_selection_new

1
configure.in
View file

@ -2229,6 +2229,7 @@ if test "${HAVE_GTK}" = "yes"; then
AC_DEFINE(HAVE_GTK_MULTIDISPLAY, 1,
[Define to 1 if GTK can handle more than one display.])
fi
dnl Check if we have the old file selection dialog.
dnl If gdk_display_open exists, assume all others are there also.
HAVE_GTK_FILE_SELECTION=no

54
lib-src/ChangeLog
View file

@ -1,3 +1,57 @@
2007-08-29 Dan Nicolaescu <dann@ics.uci.edu>
* emacsclient.c (w32_execvp): Move definition before use.
(decode_options): Don't use a tty on mac carbon or windows.
2007-08-29 Jason Rumney <jasonr@gnu.org>
* emacsclient.c (SEND_STRING, SEND_QUOTED): Remove obfuscation
macros.
(quote_argument, set_tcp_socket, handle_sigcont, handle_sigtstp):
(main): Expand removed macros inline.
(main) [WINDOWSNT]: Don't call ttyname. Don't recognize -suspend
option.
(main) [NO_SOCKETS_IN_FILE_SYSTEM]: Don't call init_signals.
2007-08-29 Karoly Lorentey <lorentey@elte.hu>
* emacsclient.c (signal.h): New include.
(sys/stat.h, errno.h): Always include, even on WINDOWSNT.
(DIRECTORY_SEP, IS_DIRECTORY_SEP, IS_DEVICE_SEP, IS_ANY_SEP): Copy
definitions here from src/lisp.h.
(main_argc, main_argv, current_frame, window_system, tty): New
variables.
(longopts): Add tty, current-frame.
(xmalloc, xstrdup): New functions.
(get_current_dir_name): New function, copied from src/sysdep.c.
(decode_options): Set display from environment. Add tty and
current_frame options. Make --no-wait imply --current-frame,
except when it is the only option given. Make sure no frame is
opened when --current-frame is set.
(print_help_and_exit): Document tty and current-frame options.
(fail): Change arguments to void.
(main): When sockets are not defined, set main_argc, main_argv,
and call fail() with no arguments.
(emacs_socket): New variable (moved out from main `s').
(quote_file_name): Rename to quote_argument.
(quote_argument): New name for old quote_file_name.
(unquote_argument, strprefix, pass_signal_to_emacs)
(handle_sigcont, handle_sigtstp, init_signals): New functions.
(set_local_socket): Initialize saved_errno to 0. If socket-name
is too long, call `fail' rather than `exit'.
(main): Doc update. Set main_argc, main_argv. New var `str'.
Don't need a filename or argument if tty or window_system set.
Call fail with no arguments. Use get_current_dir_name to send
over the current directory. Send version number to Emacs for
verification. If tty is set, check TERM, and pass name and type
to Emacs. Pass window_system to Emacs. Move sending of eval to
optind loop. Send -position, -file to Emacs. Call fsync after
fflush. Check for a client/server version match. Handle
-emacs-pid, -window-system-unsupported, -print, -error, -suspend
commands. Don't exit prematurely on --no-wait, let Emacs close
the connection for us. When creating a new frame, send
environment and pwd to Emacs. Send current-frame to Emacs.
2007-08-25 Eli Zaretskii <eliz@gnu.org>
* Makefile.in (rcs2log, rcs-checkin, grep-changelog, vcdiff):

807
lib-src/emacsclient.c
View file

File diff suppressed because it is too large Load diff

2
lib-src/makefile.w32-in
View file

@ -24,7 +24,7 @@ ALL = make-docfile hexl ctags etags movemail ebrowse sorted-doc digest-doc emacs
.PHONY: $(ALL)
VERSION = 22.1.50
VERSION = 23.0.51
LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DSTDC_HEADERS=1 -DNO_LDAV=1 \
-DNO_ARCHIVES=1 -DHAVE_CONFIG_H=1 -I../nt/inc \

309
lisp/ChangeLog
View file

@ -1,3 +1,312 @@
2007-08-29 Juri Linkov <juri@jurta.org>
* loadup.el: Add "button" loading after "faces" and move "startup"
to load after "button".
2007-08-29 Dan Nicolaescu <dann@ics.uci.edu>
* loadup.el: Load term/mac-win on a Mac using Carbon.
* 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.
* term/x-win.el (x-menu-bar-open): Use accelerate-menu.
* env.el (read-envvar-name): Don't consider the environment frame
param.
* env.el (setenv):
* frame.el (frame-initialize, make-frame):
* faces.el (tty-set-up-initial-frame-faces):
* server.el (server-process-filter): Set
display-environment-variable and term-environment-variable.
* server.el (server-process-filter): Set COLORFGBG and COLORTERM.
2007-08-29 Jason Rumney <jasonr@gnu.org>
* loadup.el: Only load term/x-win when X is compiled in.
Load term/w32-win and dependencies on windows-nt.
* term/w32-win.el: Reorder to match x-win.el more closely.
Provide w32-win. Don't throw error when global window-system not
w32.
(internal-face-interactive): Remove obsolete function.
(x-setup-function-keys): Use local-function-key-map.
(w32-initialized): New variable.
(w32-initialize-window-system): Set it.
Move more global setup here.
(x-setup-function-keys): New function.
(w32-initialize-window-system): Move non function key global setup
here.
(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.
2007-08-29 David Kastrup <dak@gnu.org>
* env.el (getenv): Pass frame to getenv-internal.
2007-08-29 Karoly Lorentey <lorentey@elte.hu>
* loadup.el: Delay loading env; mule-conf gets confused by cl
during bootstrap. Also load termdev and term/x-win.
* bindings.el (mode-line-client): New variable.
(help-echo): Add it to the default mode-line format.
* cus-start.el: Remove bogus window-system reference from GTK test.
* ebrowse.el (ebrowse-electric-list-mode-map)
(ebrowse-electric-position-mode-map):
* ebuff-menu.el (electric-buffer-menu-mode-map):
* echistory.el (electric-history-map): Bind C-z to `suspend-frame',
not `suspend-emacs'.
* ediff-wind.el (ediff-setup-windows-automatic): New function.
(ediff-window-setup-function): Use it as default.
* files.el (save-buffers-kill-terminal): New function.
(ctl-x-map): Change binding of C-x C-c to save-buffers-kill-terminal.
* font-lock.el (lisp-font-lock-keywords-2): Add `let-environment'
and `with-selected-frame'.
* help-fns.el (describe-variable): Describe frame-local variables
correctly.
* simple.el (normal-erase-is-backspace-mode): Rewrite for multiple
display support.
(normal-erase-is-backspace-setup-frame): New function.
* subr.el (with-selected-frame): New function.
(read-quoted-char): Use terminal-local binding of
local-function-key-map instead of function-key-map.
* talk.el (talk): New function.
(talk-handle-delete-frame): New function.
(talk-add-display): Open a new frame only if FRAME was not a frame.
* termdev.el: New file.
* menu-bar.el (menu-bar-open): New function. Bind it to f10.
* term/x-win.el: Don't bind f10.
* tmm.el: Remove autoload binding for f10.
* international/encoded-kb.el (encoded-kbd-setup-display): Use
`set-input-meta-mode'. Fix broken condition before set-input-mode.
Store the saved input method as a terminal parameter. Add keymap
parameter. Use it instead of changing key-translation-map directly.
(saved-key-translation-map, encoded-kbd-mode, saved-input-mode):
Remove.
(encoded-kbd-setup-display): New function.
* international/mule-cmds.el (set-locale-environment): Fix getenv
call. Use save-buffers-kill-terminal. Ignore window-system; always
set the keyboard coding system. Add DISPLAY parameter.
(set-display-table-and-terminal-coding-system): Add DISPLAY
parameter. Pass it to set-terminal-coding-system.
* international/mule.el (keyboard-coding-system): Test for
encoded-kbd-setup-display, not encoded-kbd-mode.
(set-terminal-coding-system, set-keyboard-coding-system): Add
DISPLAY parameter.
(set-keyboard-coding-system): Use encoded-kbd-setup-display.
* term/README: Update.
* term/linux.el (terminal-init-linux): Use `set-input-meta-mode'.
* term/x-win.el (x-setup-function-keys): New function. Move
function-key-map tweaks here. Protect against multiple calls on
the same terminal. Use terminal-local binding of
local-function-key-map instead of function-key-map.
(x-initialize-window-system): Make a copy of pure list. Pass a
frame getenv.
* term/vt200.el, term/vt201.el, term/vt220.el, term/vt240.el:
* term/vt300.el, term/vt320.el, term/vt400.el, term/vt420.el:
* term/AT386.el, term/internal.el, term/iris-ansi.el, term/lk201.el:
* term/mac-win.el, term/news.el, term/rxvt.el, term/sun.el:
* term/tvi970.el, term/wyse50.el: Use terminal-local binding of
local-function-key-map instead of function-key-map.
* term/rxvt.el, term/xterm.el: Speed up load time by protecting
`substitute-key-definition' and `define-key' calls against
multiple execution. Use terminal-local binding of
local-function-key-map instead of function-key-map. Pass a frame
to getenv.
* edmacro.el (edmacro-format-keys):
* emulation/cua-base.el (cua--pre-command-handler):
* isearch.el (isearch-other-meta-char):
* xt-mouse.el: Use terminal-local binding of
local-function-key-map instead of function-key-map.
* fringe.el (set-fringe-mode): Simplify and fix using
`modify-all-frames-parameters'.
* scroll-bar.el (set-scroll-bar-mode): Ditto.
* tool-bar.el (tool-bar-mode): Ditto. Remove 'tool-bar-map length
check before calling `tool-bar-setup'.
(tool-bar-setup): New variable.
(tool-bar-setup): Use it to guard against multiple calls. Add
optional frame parameter, and select that frame before adding items.
(toggle-tool-bar-mode-from-frame): New function.
* menu-bar.el (toggle-menu-bar-mode-from-frame): New function.
(menu-bar-showhide-menu): Use toggle-menu-bar-mode-from-frame and
toggle-tool-bar-mode-from-frame to change "Menu-bar" and
"Tool-bar" toggles to reflect the state of the current frame.
(menu-bar-mode): Simplify and fix using `modify-all-frames-parameters'.
* env.el Require cl for byte compilation (for `block' and `return').
(environment, setenv-internal): New functions.
(let-environment): New macro.
(setenv, getenv): Add optional terminal parameter. Update docs.
(setenv): Use setenv-internal. Always set process-environment.
Handle `local-environment-variables'.
(read-envvar-name, setenv, getenv): Use frame parameters
to store the local environment, not terminal parameters. Include
`process-environment' as well.
* faces.el (tty-run-terminal-initialization): New function.
(tty-create-frame-with-faces): Use it. Set up faces and
background mode only after the terminal has been initialized.
Call terminal-init-*. Don't load the initialization file more
than once. Call set-locale-environment.
(frame-set-background-mode): Handle the 'background-mode terminal
parameter.
(tty-find-type): New function.
(x-create-frame-with-faces): Remove bogus check for
first frame. Call `tool-bar-setup'. Don't make frame visible
until we are done setting up all its parameters. Call
x-setup-function-keys.
* frame.el (make-frame): Always inherit 'environment and 'client
parameters. Set up the 'environment frame parameter, when needed.
Also inherit 'client parameter. Don't override explicitly
specified values with inherited ones. Add 'terminal frame
parameter. Append window-system-default-frame-alist to parameters
before calling frame-creation-function.
(frame-initialize): Copy the environment from the initial frame.
(window-system-default-frame-alist): Enhance doc string.
(frame-notice-user-settings): Don't put 'tool-bar-lines in
`default-frame-alist' when initial frame is on a tty.
(modify-all-frames-parameters): Simplify using `assq-delete-all'.
Remove specified parameters from `window-system-default-frame-alist'.
(make-frame-on-tty, framep-on-display, suspend-frame):
Extend doc string, update parameter names.
(frames-on-display-list): Use terminal-id to get the display id.
(frame-notice-user-settings): Extend to apply
settings in `window-system-default-frame-alist' as well.
(terminal-id, terminal-parameters, terminal-parameter)
(set-terminal-parameter, terminal-handle-delete-frame): New functions.
(delete-frame-functions): Add to `delete-frame-functions' hook.
(blink-cursor-mode): Adapt blink-cursor-mode default
value from startup.el.
(make-frame-on-display): Protect condition on x-initialized when
x-win.el is not loaded. Update doc.
(suspend-frame): Use display-controlling-tty-p to decide between
suspend-emacs and suspend-tty.
(frames-on-display-list): Update for display ids.
(framep-on-display): Ditto.
(suspend-frame): Use display-name, not frame-tty-name.
(selected-terminal): New function.
* server.el: Use `device' instead of `display' or `display-id' in
variable and client parameter names.
(server-select-display): Remove (unused).
(server-tty-live-p, server-handle-delete-tty): Remove.
(server-unquote-arg, server-quote-arg, server-buffer-clients):
Update docs.
(server-getenv-from, server-with-environment, server-send-string)
(server-save-buffers-kill-terminal): New functions.
(server-delete-client): Handle quits in kill-buffer. Don't kill
modified buffers. Add extra logging. Delete frames after
deleting the tty. Clear 'client parameter before deleting a frame.
Use delete-display, not delete-tty.
(server-visit-files): Don't set `server-existing-buffer' if the
buffer already has other clients. Return list of buffers
created. Update doc. Don't set client-record when nowait.
(server-handle-delete-frame): Delete the client if this was its
last frame. Check that the frame is alive. Remove bogus comment.
Add note on possible race condition. Delete tty clients, if needed.
(server-handle-suspend-tty): Use server-send-string. Kill the
client in case of errors from process-send-string. Use the display
parameter.
(server-unload-hook): Remove obsolete delete-tty hook.
(server-start): Ask before restarting if the old server still has
clients. Add feedback messages. Remove obsolete delete-tty hook.
(server-process-filter): Use server-send-string. Accept `-dir'
command. Switch to *scratch* immediately after creating the frame,
before evaluating any -evals. Protect `display-splash-screen'
call in a condition-case. Explain why. Call
`display-startup-echo-area-message' before
`display-splash-screen'. Don't display the splash screen when no
frame was created. Show the Emacs splash screen and startup echo
area message. Display the *scratch* buffer by default. Store the
local environment in a frame (not terminal) parameter. Do not try
to decode environment strings. Fix reference to the 'display
frame parameter. Change syntax of environment variables. Put
environment into terminal parameters, not client parameters. Use
a dummy client with --no-wait's X frames. In `-position LINE'
handler, don't ruin the request string until the line number is
extracted. Log opened files. Handle -current-frame command.
Don't create frames when it is given. Don't bind X frames to the
client when we are in -no-wait mode. Set locale environment
variables from client while creating tty frames. Disable call to
configure-display-for-locale. When processing -position command,
don't change the request string until the parameters are
extracted. Don't try to create an X frame when Emacs does not
support it. Improve logging. Temporarily set ncurses-related
environment variables to those of the client while creating a new
tty frame. Select buffers opened by nowait clients, don't leave
them buried under others. Set the display parameter, and use it
when appropriate.
* startup.el (display-startup-echo-area-message): Handle
`inhibit-startup-echo-area-message' here.
(command-line-1): Moved from here.
(fancy-splash-screens): Use `overriding-local-map' instead of
`overriding-terminal-local-map' for now; the latter doesn't work
right, it looses keypresses to another terminal. Use
`overriding-terminal-local-map' to set up keymap. Install a
`delete-frame-functions' hook to catch `delete-frame' events.
Ignore `select-window' events to cope better with
`focus-follows-mouse'. Don't switch back to the original buffer
if the splash frame has been killed. Restore previous buffer, even
if it's *scratch*.
(normal-splash-screen): Don't let-bind `mode-line-format'; it
changes the global binding - setq it instead. Use
`save-buffers-kill-terminal'.
(display-splash-screen): Don't do anything if the splash screen is
already displayed elsewhere.
(fancy-splash-exit, fancy-splash-delete-frame): New functions.
(command-line): Replace duplicated code with a call to
tty-run-terminal-initialization. Don't load the terminal
initialization file more than once. Remove call to nonexistent
function `set-locale-translation-file-name'.
* xt-mouse.el (xterm-mouse-x, xterm-mouse-y): Convert to terminal
parameters.
(xterm-mouse-position-function, xterm-mouse-event): Update.
(xterm-mouse-mode): Don't depend on current value of window-system.
(turn-on-xterm-mouse-tracking, turn-off-xterm-mouse-tracking):
Update for multi-tty.
(turn-on-xterm-mouse-tracking-on-terminal)
(turn-off-xterm-mouse-tracking-on-terminal)
(xterm-mouse-handle-delete-frame): New functions.
(delete-frame-functions, after-make-frame-functions)
(suspend-tty-functions, resume-tty-functions): Install extra hooks
for multi-tty.
2007-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
* simple.el (invisible-p): Remove: implemented in C now.

10
lisp/bindings.el
View file

@ -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

13
lisp/cus-face.el
View file

@ -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)

10
lisp/cus-start.el
View file

@ -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))

5
lisp/double.el
View file

@ -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))

2
lisp/ebuff-menu.el
View file

@ -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)

2
lisp/echistory.el
View file

@ -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)

25
lisp/ediff-wind.el
View file

@ -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.

4
lisp/edmacro.el
View file

@ -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)

6
lisp/emulation/cua-base.el
View file

@ -1233,9 +1233,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)))

203
lisp/env.el
View file

@ -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

129
lisp/faces.el
View file

@ -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))
@ -1612,35 +1612,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
@ -1649,7 +1654,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)
@ -1746,15 +1751,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))
@ -1813,7 +1827,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)))
@ -1849,8 +1863,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))
@ -1858,6 +1879,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.
@ -1865,7 +1932,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"))))

19
lisp/files.el
View file

@ -2485,6 +2485,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
@ -5299,6 +5300,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.
@ -5396,7 +5413,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)

4
lisp/font-lock.el
View file

@ -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)
"\\>")

240
lisp/frame.el
View file

@ -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 (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)))))
(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)))))
(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.

41
lisp/fringe.el
View file

@ -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.

32
lisp/help-fns.el
View file

@ -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)))

106
lisp/international/encoded-kb.el
View file

@ -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.
(defun encoded-kbd-setup-display (display)
"Set up a `key-translation-map' for `keyboard-coding-system' on DISPLAY.
You should not turn this mode on manually, instead use the command
\\[set-keyboard-coding-system] which turns on or off this mode
automatically.
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)))))
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)))
(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)

101
lisp/international/mule-cmds.el
View file

@ -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))))
;; 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)))
(setq locale-coding-system
(car (get-language-info language-name 'coding-priority))))
(unless frame
(setq locale-coding-system
(car (get-language-info language-name 'coding-priority)))))
(when (and coding-system
(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

37
lisp/international/mule.el
View file

@ -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"

4
lisp/isearch.el
View file

@ -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

2319
lisp/ldefs-boot.el
View file

File diff suppressed because it is too large Load diff

18
lisp/loadup.el
View file

@ -60,10 +60,10 @@
(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)
@ -72,6 +72,9 @@
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
(load "button")
(load "startup")
(message "Lists of integers (garbage collection statistics) are normal output")
(message "while building Emacs; they do not indicate a problem.")
(message "%s" (garbage-collect))
@ -132,6 +135,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'
@ -154,7 +158,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")
@ -180,7 +183,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)
@ -188,6 +194,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")
@ -205,6 +214,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")))

48
lisp/menu-bar.el
View file

@ -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

4
lisp/progmodes/ebrowse.el
View file

@ -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)

17
lisp/scroll-bar.el
View file

@ -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.

1026
lisp/server.el
View file

File diff suppressed because it is too large Load diff

195
lisp/simple.el
View file

@ -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)
@ -5626,36 +5618,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.
(defcustom normal-erase-is-backspace 'maybe
"Set the default behaviour of the Delete and Backspace keys.
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 set to t, Delete key deletes forward and Backspace key deletes
backward.
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.
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)
@ -5665,17 +5654,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
@ -5697,54 +5707,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)))
(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 function-key-map [delete])))
(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 normal-erase-is-backspace
(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-?]))
(keyboard-translate ?\C-h ?\C-?)
(keyboard-translate ?\C-? ?\C-d))
(keyboard-translate ?\C-h ?\C-h)
(keyboard-translate ?\C-? ?\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"))))
(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.")

313
lisp/startup.el
View file

@ -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 'environment)
@ -458,36 +465,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)
@ -528,6 +518,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)
@ -632,16 +636,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)
@ -657,13 +667,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.
@ -786,7 +792,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))
@ -800,7 +806,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)
@ -809,13 +814,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
@ -1081,31 +1088,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.
@ -1398,7 +1382,7 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
"Stop displaying the splash screen buffer."
(interactive)
(if fancy-splash-outer-buffer
(throw 'exit nil)
(throw 'stop-splashing nil)
(quit-window t)))
(defun fancy-splash-screens (&optional static)
@ -1433,7 +1417,10 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
(recursive-edit))
(cancel-timer timer)
(setq display-hourglass old-hourglass)
(kill-buffer splash-buffer)))))
(kill-buffer splash-buffer)
(when (frame-live-p frame)
(select-frame frame)
(switch-to-buffer fancy-splash-outer-buffer))))))
;; If static is non-nil, don't show fancy splash screen.
(if (or (window-minibuffer-p)
(window-dedicated-p (selected-window)))
@ -1585,17 +1572,17 @@ To quit a partially entered command, type Control-g.\n")
(insert "\n" (emacs-version)
"\n" emacs-copyright))
;; No mouse menus, so give help using kbd commands.
;; 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))
;; 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))
(progn
(insert "
Get help C-h (Hold down CTRL and press h)
@ -1646,7 +1633,7 @@ Get help %s
'action (lambda (button) (view-order-manuals))
'follow-link t)
(insert (substitute-command-keys
"\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]")))
"\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]")))
;; Say how to use the menu bar with the keyboard.
(insert "\n")
@ -1658,8 +1645,8 @@ Get help %s
(insert " F10 or ESC ` or M-`")
(insert (substitute-command-keys " \\[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.)")
@ -1688,9 +1675,9 @@ If you have no Meta key, you may instead type ESC followed by the character.)")
(insert "\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))
(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))
(progn
(insert
"\n
@ -1729,25 +1716,25 @@ Type \\[describe-distribution] for information on "))
'follow-link t)
(insert ".")))
;; The rest of the startup screen is the same on all
;; kinds of terminals.
;; 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"
;; 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.\n"))
(use-local-map splash-screen-keymap)
@ -1758,20 +1745,18 @@ Type \\[describe-distribution] for information on "))
(if (and view-read-only (not view-mode))
(view-mode-enter nil 'kill-buffer))
(goto-char (point-min))
(if (not static)
(if (or (window-minibuffer-p)
(window-dedicated-p (selected-window)))
;; If static 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 (not static)
(if (or (window-minibuffer-p)
(window-dedicated-p (selected-window)))
;; If static 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 (not static)
(kill-buffer "*About GNU Emacs*")
@ -1789,7 +1774,45 @@ Type \\[describe-distribution] for information on "))
(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 static)
@ -1798,52 +1821,16 @@ 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 static)
(normal-splash-screen static)))
;; Prevent recursive calls from server-process-filter.
(if (not (get-buffer "*About GNU Emacs*"))
(if (use-fancy-splash-screens-p)
(fancy-splash-screens static)
(normal-splash-screen static))))
(defalias 'about-emacs 'display-splash-screen)
(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.

19
lisp/subr.el
View file

@ -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.

39
lisp/talk.el
View file

@ -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)

48
lisp/term/AT386.el
View file

@ -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"))
(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])
;; 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 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])
;; 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
)
;; 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

50
lisp/term/README
View file

@ -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.

4
lisp/term/apollo.el
View file

@ -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

2
lisp/term/bobcat.el
View file

@ -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))

2
lisp/term/cygwin.el
View file

@ -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

28
lisp/term/internal.el
View file

@ -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)

390
lisp/term/iris-ansi.el
View file

@ -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 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[120q" [S-escape])
(define-key iris-function-map "\e[121q" [C-escape])
(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 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[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 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 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[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 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 function-key-map "\e[049q" [?\C-1])
(define-key function-key-map "\e[058q" [?\M-1])
(define-key iris-function-map "\e[057q" [?\C-`])
(define-key iris-function-map "\e[115q" [?\M-`])
(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 function-key-map "\e[050q" [?\C-3])
(define-key function-key-map "\e[060q" [?\M-3])
(define-key iris-function-map "\e[059q" [?\M-2])
(define-key function-key-map "\e[051q" [?\C-4])
(define-key function-key-map "\e[061q" [?\M-4])
(define-key iris-function-map "\e[050q" [?\C-3])
(define-key iris-function-map "\e[060q" [?\M-3])
(define-key function-key-map "\e[052q" [?\C-5])
(define-key function-key-map "\e[062q" [?\M-5])
(define-key iris-function-map "\e[051q" [?\C-4])
(define-key iris-function-map "\e[061q" [?\M-4])
(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 function-key-map "\e[053q" [?\C-7])
(define-key function-key-map "\e[064q" [?\M-7])
(define-key iris-function-map "\e[063q" [?\M-6])
(define-key function-key-map "\e[054q" [?\C-8])
(define-key function-key-map "\e[065q" [?\M-8])
(define-key iris-function-map "\e[053q" [?\C-7])
(define-key iris-function-map "\e[064q" [?\M-7])
(define-key function-key-map "\e[055q" [?\C-9])
(define-key function-key-map "\e[066q" [?\M-9])
(define-key iris-function-map "\e[054q" [?\C-8])
(define-key iris-function-map "\e[065q" [?\M-8])
(define-key function-key-map "\e[056q" [?\C-0])
(define-key function-key-map "\e[067q" [?\M-0])
(define-key iris-function-map "\e[055q" [?\C-9])
(define-key iris-function-map "\e[066q" [?\M-9])
(define-key function-key-map "\e[068q" [?\M--])
(define-key iris-function-map "\e[056q" [?\C-0])
(define-key iris-function-map "\e[067q" [?\M-0])
(define-key function-key-map "\e[069q" [?\C-=])
(define-key function-key-map "\e[070q" [?\M-=])
(define-key iris-function-map "\e[068q" [?\M--])
;; I don't know what to do with those.
;;(define-key function-key-map "^H" [<del>])
;;(define-key function-key-map "^H" [S-<del>])
;;(define-key function-key-map "\177" [C-<del>])
;;(define-key function-key-map "\e[071q" [M-<del>])
(define-key iris-function-map "\e[069q" [?\C-=])
(define-key iris-function-map "\e[070q" [?\M-=])
(define-key function-key-map "\e[Z" [?\S-\t])
(define-key function-key-map "\e[072q" [?\C-\t])
;; This only works if you remove the M-TAB keybing from the system.4Dwmrc
;; our your ~/.4Dwmrc, if you use the 4Dwm window manager.
(define-key function-key-map "\e[073q" [?\M-\t])
;; I don't know what to do with those.
;;(define-key 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[074q" [?\M-q])
(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[075q" [?\M-w])
(define-key iris-function-map "\e[074q" [?\M-q])
(define-key function-key-map "\e[076q" [?\M-e])
(define-key iris-function-map "\e[075q" [?\M-w])
(define-key function-key-map "\e[077q" [?\M-r])
(define-key iris-function-map "\e[076q" [?\M-e])
(define-key function-key-map "\e[078q" [?\M-t])
(define-key iris-function-map "\e[077q" [?\M-r])
(define-key function-key-map "\e[079q" [?\M-y])
(define-key iris-function-map "\e[078q" [?\M-t])
(define-key function-key-map "\e[080q" [?\M-u])
(define-key iris-function-map "\e[079q" [?\M-y])
(define-key function-key-map "\e[081q" [?\M-i])
(define-key iris-function-map "\e[080q" [?\M-u])
(define-key function-key-map "\e[082q" [?\M-o])
(define-key iris-function-map "\e[081q" [?\M-i])
(define-key function-key-map "\e[083q" [?\M-p])
(define-key iris-function-map "\e[082q" [?\M-o])
(define-key function-key-map "\e[084q" [?\M-\[])
(define-key iris-function-map "\e[083q" [?\M-p])
(define-key function-key-map "\e[085q" [?\M-\]])
(define-key iris-function-map "\e[084q" [?\M-\[])
(define-key function-key-map "\e[086q" [?\M-\\])
(define-key iris-function-map "\e[085q" [?\M-\]])
(define-key function-key-map "\e[087q" [?\M-a])
(define-key iris-function-map "\e[086q" [?\M-\\])
(define-key function-key-map "\e[088q" [?\M-s])
(define-key iris-function-map "\e[087q" [?\M-a])
(define-key function-key-map "\e[089q" [?\M-d])
(define-key iris-function-map "\e[088q" [?\M-s])
(define-key function-key-map "\e[090q" [?\M-f])
(define-key iris-function-map "\e[089q" [?\M-d])
(define-key function-key-map "\e[091q" [?\M-g])
(define-key iris-function-map "\e[090q" [?\M-f])
(define-key function-key-map "\e[092q" [?\M-h])
(define-key iris-function-map "\e[091q" [?\M-g])
(define-key function-key-map "\e[093q" [?\M-j])
(define-key iris-function-map "\e[092q" [?\M-h])
(define-key function-key-map "\e[094q" [?\M-k])
(define-key iris-function-map "\e[093q" [?\M-j])
(define-key function-key-map "\e[095q" [?\M-l])
(define-key iris-function-map "\e[094q" [?\M-k])
(define-key function-key-map "\e[096q" [?\C-\;])
(define-key function-key-map "\e[097q" [?\M-:]) ;; we are cheating
;; here, this is
;; realy M-;, but
;; M-: generates the
;; same string and
;; is more usefull.
(define-key iris-function-map "\e[095q" [?\M-l])
(define-key function-key-map "\e[098q" [?\C-'])
(define-key function-key-map "\e[099q" [?\M-'])
(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[100q" [?\M-\n])
(define-key iris-function-map "\e[098q" [?\C-'])
(define-key iris-function-map "\e[099q" [?\M-'])
(define-key function-key-map "\e[101q" [?\M-z])
(define-key iris-function-map "\e[100q" [?\M-\n])
(define-key function-key-map "\e[102q" [?\M-x])
(define-key iris-function-map "\e[101q" [?\M-z])
(define-key function-key-map "\e[103q" [?\M-c])
(define-key iris-function-map "\e[102q" [?\M-x])
(define-key function-key-map "\e[104q" [?\M-v])
(define-key iris-function-map "\e[103q" [?\M-c])
(define-key function-key-map "\e[105q" [?\M-b])
(define-key iris-function-map "\e[104q" [?\M-v])
(define-key function-key-map "\e[106q" [M-n])
(define-key iris-function-map "\e[105q" [?\M-b])
(define-key function-key-map "\e[107q" [M-m])
(define-key iris-function-map "\e[106q" [M-n])
(define-key function-key-map "\e[108q" [?\C-,])
(define-key function-key-map "\e[109q" [?\M-,])
(define-key iris-function-map "\e[107q" [M-m])
(define-key function-key-map "\e[110q" [?\C-.])
(define-key function-key-map "\e[111q" [?\M-.])
(define-key iris-function-map "\e[108q" [?\C-,])
(define-key iris-function-map "\e[109q" [?\M-,])
(define-key function-key-map "\e[112q" [?\C-/])
(define-key function-key-map "\e[113q" [?\M-/])
(define-key iris-function-map "\e[110q" [?\C-.])
(define-key iris-function-map "\e[111q" [?\M-.])
(define-key function-key-map "\e[139q" [insert])
(define-key function-key-map "\e[139q" [S-insert])
(define-key function-key-map "\e[140q" [C-insert])
(define-key function-key-map "\e[141q" [M-insert])
(define-key iris-function-map "\e[112q" [?\C-/])
(define-key iris-function-map "\e[113q" [?\M-/])
(define-key function-key-map "\e[H" [home])
(define-key function-key-map "\e[143q" [S-home])
(define-key function-key-map "\e[144q" [C-home])
(define-key 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 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

5
lisp/term/linux.el
View file

@ -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

125
lisp/term/lk201.el
View file

@ -1,72 +1,83 @@
;; -*- no-byte-compile: t -*-
;; Define function key sequences 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])
(defvar lk201-function-map (make-sparse-keymap)
"Function key definitions for DEC terminals.")
(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])
;; Termcap or terminfo should set these.
;; (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 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 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])
(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])
(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

197
lisp/term/mac-win.el
View file

@ -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.
@ -2294,34 +2297,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")
@ -2499,6 +2474,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
@ -2605,50 +2662,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."
@ -2696,7 +2710,6 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
(mac-scroll-ignore-events)
(scroll-up 1)))
)
;;;; Others
@ -2734,5 +2747,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

6
lisp/term/news.el
View file

@ -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"))

249
lisp/term/rxvt.el
View file

@ -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

2
lisp/term/sun.el
View file

@ -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])

19
lisp/term/tvi970.el
View file

@ -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

3
lisp/term/vt100.el
View file

@ -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)

4
lisp/term/vt102.el
View file

@ -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

4
lisp/term/vt125.el
View file

@ -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

7
lisp/term/vt200.el
View file

@ -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

6
lisp/term/vt201.el
View file

@ -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

6
lisp/term/vt220.el
View file

@ -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

6
lisp/term/vt240.el
View file

@ -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

6
lisp/term/vt300.el
View file

@ -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

6
lisp/term/vt320.el
View file

@ -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

6
lisp/term/vt400.el
View file

@ -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

8
lisp/term/vt420.el
View file

@ -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

286
lisp/term/w32-win.el
View file

@ -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.
;;; 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))
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.
(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)
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])
(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

14
lisp/term/wyse50.el
View file

@ -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
))

350
lisp/term/x-win.el
View file

@ -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,141 +2402,6 @@ 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)))))
;; 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))))
;; Set scroll bar mode to right if set by X resources. Default is left.
(if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right")
(customize-set-variable 'scroll-bar-mode 'right))
(defun x-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)
;; Turn off window-splitting optimization; X is usually fast enough
;; that this is only annoying.
(setq split-window-keep-point t)
;; Don't show the frame name; that's redundant with X.
(setq-default mode-line-frame-identification " ")
;; 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)
;; Override Paste so it looks at CLIPBOARD first.
(defun x-clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
@ -2537,10 +2411,156 @@ order until succeed.")
(kill-new clipboard-text))
(yank)))
(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"))
(defun x-menu-bar-open (&optional frame)
"Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'."
(interactive "i")
(if menu-bar-mode (accelerate-menu frame)
(tmm-menubar)))
;;; Window system initialization.
(defun x-win-suspend-error ()
(error "Suspending an Emacs running under X makes no sense"))
(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)))))
;; 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 let Emacs suspend under X.
(add-hook 'suspend-hook 'x-win-suspend-error)
;; Turn off window-splitting optimization; X is usually fast enough
;; that this is only annoying.
(setq split-window-keep-point t)
;; 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)
;; 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))
(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)

703
lisp/term/xterm.el
View file

@ -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 [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] 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 [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] 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 [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] 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)
(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 (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])
(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)

195
lisp/termdev.el Normal file
View file

@ -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

1
lisp/tmm.el
View file

@ -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

105
lisp/tool-bar.el
View file

@ -55,22 +55,22 @@ 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
@ -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")
(defvar tool-bar-setup nil
"t if the tool-bar has been set up by `tool-bar-setup'.")
;; There's no icon appropriate for News and we need a command rather
;; than a lambda for Read Mail.
(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)
;;; arch-tag: 15f30f0a-d0d7-4d50-bbb7-f48fd0c8582f
;;; tool-bar.el ends here

7
lisp/version.el
View file

@ -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

17
lisp/x-dnd.el
View file

@ -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."

59
lisp/xt-mouse.el
View file

@ -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
@ -202,7 +207,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
@ -211,15 +216,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)

5
lispref/ChangeLog
View file

@ -1,3 +1,8 @@
2007-08-29 Dan Nicolaescu <dann@ics.uci.edu>
* frames.texi (Basic Parameters): Add display-environment-variable
and term-environment-variable.
2007-08-28 Juri Linkov <juri@jurta.org>
* display.texi (Image Formats, Other Image Types): Add SVG.

8
lispref/frames.texi
View file

@ -378,6 +378,14 @@ you don't specify a name, Emacs sets the frame name automatically
If you specify the frame name explicitly when you create the frame, the
name is also used (instead of the name of the Emacs executable) when
looking up X resources for the frame.
@item display-environment-variable
The value of the @code{DISPLAY} environment variable for the frame. It
is passed to child processes.
@item term-environment-variable
The value of the @code{TERM} environment variable for the frame. It
is passed to child processes.
@end table
@node Position Parameters

5
lwlib/ChangeLog
View file

@ -1,3 +1,8 @@
2007-08-29 Karoly Lorentey <lorentey@elte.hu>
* xlwmenu.c (XlwMenuRealize): Ignore X errors while setting up
cursor shape.
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.

9
lwlib/xlwmenu.c
View file

@ -1844,7 +1844,16 @@ XlwMenuRealize (w, valueMask, attributes)
xswa.save_under = True;
xswa.cursor = mw->menu.cursor_shape;
mask = CWSaveUnder | CWCursor;
/* I sometimes get random BadCursor errors while creating the first
frame on a display. I can not find their reason, but they are
annoying so for now let's ignore any errors here. -- lorentey */
#ifdef emacs
x_catch_errors (XtDisplay (w));
#endif
XChangeWindowAttributes (XtDisplay (w), XtWindow (w), mask, &xswa);
#ifdef emacs
x_uncatch_errors ();
#endif
mw->menu.windows [0].window = XtWindow (w);
mw->menu.windows [0].x = w->core.x;

7
mac/ChangeLog
View file

@ -1,3 +1,10 @@
2007-08-29 Karoly Lorentey <lorentey@elte.hu>
* makefile.MPW (EmacsObjects): Add terminal.c.x.
(callproc.c.x): Add dependencies frame.h, termhooks.h.
({Src}terminal.c.x): New.
(shortlisp): Add server.elc and termdev.elc.
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.

21
mac/makefile.MPW
View file

@ -118,6 +118,7 @@ EmacsObjects =
"{Src}sysdep.c.x" ¶
"{Src}term.c.x" ¶
"{Src}termcap.c.x" ¶
"{Src}terminal.c.x" ¶
"{Src}textprop.c.x" ¶
"{Src}tparam.c.x" ¶
"{Src}undo.c.x" ¶
@ -260,8 +261,8 @@ buildobj.lst
{CONFIG_H_GROUP} ¶
"{Includes}sys:types.h" ¶
"{Includes}sys:file.h" ¶
"{Includes}sys:types.h" ¶
"{Includes}sys:stat.h" ¶
"{Includes}sys:types.h" ¶
"{Includes}sys:stat.h" ¶
"{Src}lisp.h" ¶
"{Src}commands.h" ¶
"{Src}buffer.h" ¶
@ -273,7 +274,9 @@ buildobj.lst
"{Src}process.h" ¶
"{Src}syssignal.h" ¶
"{Src}systty.h" ¶
"{Includes}termio.h"
"{Includes}termio.h" ¶
"{Src}frame.h" ¶
"{Src}termhooks.h"
{Src}casefiddle Ä ¶
{CONFIG_H_GROUP} ¶
@ -798,6 +801,16 @@ buildobj.lst
"{Src}lisp.h" ¶
"{Includes}sys:file.h"
{Src}terminal.c.x Ä ¶
{CONFIG_H_GROUP} ¶
"{Src}lisp.h" ¶
"{Src}frame.h" ¶
"{Src}termchar.h" ¶
"{Src}termhooks.h" ¶
"{Src}charset.h" ¶
"{Src}coding.h" ¶
"{Src}keyboard.h"
{Src}textproc.c.x Ä ¶
{CONFIG_H_GROUP} ¶
"{Src}lisp.h" ¶
@ -1014,6 +1027,7 @@ shortlisp =
{Lisp}abbrev.elc ¶
{Lisp}buff-menu.elc ¶
{Lisp}button.elc ¶
{Lisp}server.elc ¶
{Lisp}emacs-lisp:byte-run.elc ¶
{Lisp}cus-face.elc ¶
{Lisp}cus-start.elc ¶
@ -1027,6 +1041,7 @@ shortlisp =
{Lisp}emacs-lisp:float-sup.elc ¶
{Lisp}format.elc ¶
{Lisp}frame.elc ¶
{Lisp}termdev.elc ¶
{Lisp}help.elc ¶
{Lisp}indent.elc ¶
{Lisp}isearch.elc ¶

3
src/.arch-inventory
View file

@ -3,7 +3,10 @@ source ^\.(gdbinit|dbxinit)$
# Auto-generated files, which ignore
precious ^(config\.stamp|config\.h|epaths\.h|buildobj\.lst)$
precious ^(TAGS-LISP)$
precious ^(buildobj\.lst)$
backup ^(stamp-oldxmenu|prefix-args|temacs|emacs|emacs-[0-9.]*)$
backup ^(bootstrap-emacs)$
# arch-tag: 277cc7ae-b3f5-44af-abf1-84c073164543

2
src/.gdbinit
View file

@ -1115,7 +1115,7 @@ end
tbreak init_sys_modes
commands
silent
xgetptr Vwindow_system
xgetptr Vinitial_window_system
set $tem = (struct Lisp_Symbol *) $ptr
xgetptr $tem->xname
set $tem = (struct Lisp_String *) $ptr

606
src/ChangeLog
View file

@ -1,3 +1,609 @@
2007-08-29 Dan Nicolaescu <dann@ics.uci.edu>
* callproc.c (child_setup, getenv_internal): Use the
display-environment-variable and term-environment-variable frame
params.
(set_initial_environment): Initialise Vprocess_environment.
* config.in: Disable multi-keyboard support on a mac.
* frame.c (Qterm_environment_variable)
(Qdisplay_environment_variable): New variables.
(syms_of_frame): Intern and staticpro them.
(Fmake_terminal_frame): Disable output method test.
* frame.h: Declare them here.
* macfns.c (x_set_mouse_color): Get rif from the frame.
(x_set_tool_bar_lines): Don't use updating_frame.
(mac_window): Add 2 new parameters for consistency with other systems.
(Fx_create_frame): Fix doc string. Rename the parameter. Set the
frame parameters following what is done in X11 and w32. Don't use
FRAME_MAC_DISPLAY_INFO.
(Fx_open_connection, start_hourglass): Remove window-system check.
(x_create_tip_frame): Get the keyboard from the terminal.
* macmenu.c: Reorder includes.
(Fx_popup_menu): Use terminal specific mouse_position_hook.
* macterm.c (XTset_terminal_modes, XTreset_terminal_modes): Add a
terminal parameter.
(x_clear_frame): Add a frame parameter.
(note_mouse_movement): Get rif from the frame.
(mac_term_init): Initialize the terminal.
(mac_initialize): Make static and move terminal initialization ...
(mac_create_terminal): ... to this new function.
* macterm.h (struct mac_display_info): Add terminal.
* puresize.h (BASE_PURESIZE): Increase base value to 1158000.
* sysdep.c: Comment out text after #endif.
* term.c (init_tty): Only use terminal->kboard when MULTI_KBOARD
is defined. Better initialize ttys in windows. Use terminal
specific mouse_position_hook.
* termhooks.h (union display_info): Add mac_display_info.
* w32fns.c (Fx_create_frame): Use kboard from the terminal. Set
the default minibuffer frame, window_system and the rest of the
frame parameters following what is done in X11.
* w32term.c (w32_initialize): Make static.
* xselect.c (x_handle_selection_clear): Only access
terminal->kboard when MULTI_KBOARD is defined.
* s/darwin.h (SYSTEM_PURESIZE_EXTRA): Define here.
(SYSTEM_PURESIZE_EXTRA): Only define on Carbon.
2007-08-29 Jason Rumney <jasonr@gnu.org>
* frame.c (Fdelete_frame): Only get kboard when MULTI_KBOARD defined.
(make_terminal_frame) [WINDOWSNT]: Initialize terminal.
* fringe.c (w32_init_fringe w32_reset_fringes) [HAVE_NTGUI]:
(mac_init_fringe) [MAC_OS]: Get rif from selected_frame.
* keyboard.c (restore_kboard_configuration): Only define when
MULTI_KBOARD defined.
* makefile.w32-in: Update dependancies from Makefile.in
(OBJ1): Add terminal.$(O)
* term.c (dissociate_if_controlling_tty) [WINDOWSNT]: Don't
define function body.
(init_tty) [WINDOWSNT]: Use selected_frame for initializing.
* termhooks.h (display_info) [WINDOWSNT]: Add w32.
* w32.c (request_sigio, unrequest_sigio): Remove.
* w32console.c (w32con_move_cursor, w32con_clear_to_end)
(w32con_clear_frame, w32con_clear_end_of_line)
(w32con_ins_del_lines, w32con_insert_glyphs, w32con_write_glyphs)
(w32con_delete_glyphs, w32con_set_terminal_window)
(scroll_line, w32_sys_ring_bell): Add frame arg.
(w32con_set_terminal_modes, w32con_reset_terminal_modes): Add
terminal arg.
(PICK_FRAME): Remove.
(w32con_write_glyphs): Use frame specific terminal coding.
(one_and_only_w32cons): New global variable.
(initialize_w32_display): Use it for storing hooks.
(create_w32cons_output): New function.
* w32inevt.c, w32inevt.h (w32_console_read_socket): Make first
arg a frame.
* w32fns.c (x_create_tip_frame): Set terminal and ref count. Set
window_system.
(x_set_tool_bar_lines): Don't use updating_frame.
(Fx_create_frame): Set terminal and ref count.
(Fx_open_connection): Remove window-system check.
* w32menu.c (Fx_popup_menu): Use terminal specific mouse_position_hook.
* w32term.c (w32_term_init): Call add_keyboard_wait_descriptor.
(w32_set_terminal_modes, w32_reset_terminal_modes): Add terminal arg.
(x_clear_frame, x_delete_glyphs, w32_ring_bell, x_ins_del_lines):
Add frame arg.
(x_delete_terminal, w32_create_terminal): New functions.
(w32_term_init): Create a terminal.
(w32_initialize): Move terminal specific initialization to
w32_create_terminal.
* w32term.h (x_output): Remove foreground_pixel and
background_pixel.
(w32_clear_rect, w32_clear_area): Use background from frame.
(w32_display_info): Add terminal.
(w32_sys_ring_bell, x_delete_display): Declare here.
* xdisp.c (display_menu_bar) [HAVE_NTGUI]: Check frame type.
* s/ms-w32.h (SYSTEM_PURESIZE_EXTRA): Bump to 50k.
2007-08-29 Kalle Olavi Niemitalo <kon@iki.fi> (tiny change)
* keyboard.c (interrupt_signal, handle_interrupt, Fset_quit_char):
Fix get_named_tty calls for the controlling tty.
2007-08-29 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
* term.c (dissociate_if_controlling_tty)[USG]: Fix parse error.
2007-08-29 Yoshiaki Kasahara <kasahara@nc.kyushu-u.ac.jp> (tiny change)
* term.c (tty_insert_glyphs): Add missing first parameter.
2007-08-29 Karoly Lorentey <karoly@lorentey.hu>
* buffer.c (Fbuffer_list, Fbury_buffer): Take
frame->buried_buffer_list into account.
* cm.c (current_tty): New variable, for cmputc().
(cmputc): Use it.
(cmcheckmagic): Add tty parameter, look up terminal streams there.
(calccost): Add tty parameter. Use emacs_tputs() instead of tputs().
(cmgoto): Add tty parameter. Pass it on to calccost(). Use
emacs_tputs() instead of tputs().
* cm.h (emacs_tputs): New macro to set current_tty, and then call
tputs().
(current_tty): New variable, for cmputc().
(cmcheckmagic, cmputc, cmgoto): Add prototypes.
* eval.c (unwind_to_catch): Don't call x_fully_uncatch_errors.
(internal_condition_case, internal_condition_case_1)
(internal_condition_case_2): Don't abort when x_catching_errors.
* fns.c (Fyes_or_no_p): Don't try to open an X dialog on tty terminals.
(Fy_or_n_p): Likewise. Use temporarily_switch_to_single_kboard to
prevent crashes caused by bogus longjmps in read_char.
* keymap.h (Fset_keymap_parent): Add EXFUN.
* macterm.h (FRAME_FOREGROUND_PIXEL, FRAME_BACKGROUND_PIXEL)
* w32term.h (FRAME_FOREGROUND_PIXEL, FRAME_BACKGROUND_PIXEL):
Remove redundant definition.
* macfns.c (x_set_mouse_color,x_make_gc): Use
FRAME_BACKGROUND_PIXEL and FRAME_FOREGROUND_PIXEL.
* w32term.c (x_free_frame_resources): Use
FRAME_BACKGROUND_PIXEL and FRAME_FOREGROUND_PIXEL.
(w32_initialize): Use the accessor macros for terminal characteristics.
* macterm.c (mac_initialize): Use Fset_input_interrupt_mode.
Use the accessor macros for terminal characteristics.
* msdos.c (internal_terminal_init): Use the accessor macros for
terminal characteristics.
(ScreenVisualBell,internal_terminal_init): Use
FRAME_BACKGROUND_PIXEL and FRAME_FOREGROUND_PIXEL.
* termopts.h (no_redraw_on_reenter): Declare.
* alloc.c (emacs_blocked_malloc): Disable mallopt call.
(mark_terminals,mark_ttys): Declare.
(Fgarbage_collect): Call them.
(mark_object): Mark buried_buffer_list;
* prefix-args.c: Include stdlib.h for exit.
* syssignal.h: Add comment.
* indent.c: Include stdio.h.
* window.h (Vinitial_window_system): Declare.
(Vwindow_system): Delete declaration.
* fontset.c (Finternal_char_font): Use FRAME_RIF.
* image.c (lookup_image): Don't initialize `c' until the xasserts
have been run.
* gtkutil.c (xg_create_frame_widgets): Use FRAME_BACKGROUND_PIXEL and
FRAME_FOREGROUND_PIXEL.
* print.c (print_preprocess): Don't lose print_depth levels while
iterating.
* widget.c (update_from_various_frame_slots): Use
FRAME_BACKGROUND_PIXEL and FRAME_FOREGROUND_PIXEL.
* window.c (set_window_buffer): Don't call clear_mouse_face on tty
frames.
(window_internal_height): Remove bogus make_number call.
(init_window_once): Call make_terminal_frame with two zero
parameters.
* fileio.c (Fread_file_name): Update comment.
* callint.c (Fcall_interactively): Use
temporarily_switch_to_single_kboard instead of single_kboard_state.
Make sure it is correctly unwound.
* xsmfns.c (x_session_close): New function.
* coding.h (terminal_coding,safe_terminal_coding,keyboard_coding):
Delete declarations.
* xterm.h: Remove declaration for x_fully_uncatch_errors.
(x_output): Remove background_pixel and foreground_pixel fields.
(x_display_info): Add new field TERMINAL. Remove KBOARD field.
(x_delete_device):
(x_session_close): Declare.
* lread.c: Include setjmp.h. Update declaration of `read_char'.
(read_filtered_event): Call `read_char' with a local
`wrong_kboard_jmpbuf'.
* minibuf.c (read_minibuf): Call
temporarily_switch_to_single_kboard. Don't call
single_kboard_state. Use FRAME_RIF.
* process.c (Fmake_network_process): Don't unrequest_sigio on modern
systems.
* lisp.h (set_process_environment): Rename to
`set_global_environment'.
(Fframe_with_environment,Fset_input_meta_mode)
(Fset_quit_char): EXFUN.
(x_create_device,tty_output,terminal,tty_display_info): Declare.
(init_sys_modes, reset_sys_modes): Update prototypes.
(init_all_sys_modes, reset_all_sys_modes): New prototypes.
* keyboard.h (struct kboard): Add new fields:
Vlocal_function_key_map, Vlocal_key_translation_map,
Vkeyboard_translate_table.
(Vfunction_key_map,Vkeyboard_translate_table,single_kboard_state):
Delete declarations.
(Vfunction_key_map,Vkey_translation_map,push_kboard,pop_kboard)
(temporarily_switch_to_single_kboard,tty_read_avail_input):
New declarations.
* emacs.c (main): Don't call init_sys_modes(), the new term_init()
already does that during init_display(). Call syms_of_keymap
before syms_of_keyboard. Call `syms_of_terminal'. Call
set_initial_environment, not set_process_environment.
(shut_down_emacs): Call reset_all_sys_modes() instead of
reset_sys_modes().
* xfaces.c (x_free_gc): Protect xassert with GLYPH_DEBUG.
(internal_resolve_face_name, resolve_face_name_error): New
functions.
(resolve_face_name): Protect against loops and errors thrown by
Fget.
(realize_default_face): Don't use FRAME_FONT unless frame is an X
frame.
(Ftty_supports_face_attributes_p): Update tty_capable_p call.
* scroll.c: Replace CURTTY() with local variables throughout the
file (where applicable).
(calculate_scrolling, calculate_direct_scrolling)
(scrolling_1, scroll_cost): Use the accessor macros for terminal
characteristics.
* keymap.c (Vfunction_key_map): Remove.
(Fdescribe_buffer_bindings): Update references to
Vfunction_key_map.
(syms_of_keymap): Remove DEFVAR for Vfunction_key_map.
(Vkey_translation_map): Remove.
(syms_of_keymap): Remove DEFVAR for key-translation-map.
(Fdescribe_buffer_bindings):
(read_key_sequence, init_kboard, syms_of_keyboard, mark_kboards):
Update for terminal-local key-translation-map.
* Makefile.in (callproc.o): Update dependencies.
(lisp, shortlisp): Add termdev.elc.
(obj): Add terminal.o.
(terminal.o): Add dependencies.
[HAVE_CARBON]: Make terminal.o depend on macgui.h.
(data.o, fns.o): Add termhooks.h dependency.
(SOME_MACHINE_LISP): Add dnd.elc.
(minibuf.o): Fix typo.
Update dependencies.
* data.c (do_symval_forwarding, store_symval_forwarding)
(find_symbol_value): Use the selected frame's keyboard, not
current_kboard.
* .gdbinit (init_sys_modes): Use Vinitial_window_system instead of
Vwindow_system.
* xmenu.c (Fx_menu_bar_open) [USE_X_TOOLKIT, USE_GTK]: Rename from
Fmenu_bar_open.
(syms_of_xmenu): Update defsubr.
(mouse_position_for_popup, Fx_popup_menu)
(Fx_popup_dialog, x_activate_menubar, update_frame_menubar)
(set_frame_menubar, free_frame_menubar)
(create_and_show_popup_menu, xmenu_show, )
(create_and_show_dialog, xdialog_show, xmenu_show): Abort if not
an X frame.
* xselect.c (x_own_selection): Abort if not an X frame.
(some_frame_on_display): Check if it is an X frame.
(x_handle_selection_clear): Deal with MULTI_KBOARD.
* coding.c: Include frame.h and termhooks.h.
(terminal_coding,keyboard_coding): Delete.
(Fset_terminal_coding_system_internal):
(Fset_keyboard_coding_system_internal):
(Fkeyboard_coding_system):
(Fterminal_coding_system): Add a terminal parameter. Get
terminal_coding from the terminal.
(init_coding_once): Don't call setup_coding_system here.
* dispextern.h (set_scroll_region, turn_off_insert)
(turn_off_highlight, background_highlight, clear_end_of_line_raw)
(tty_clear_end_of_line, tty_setup_colors)
(delete_tty,updating_frame)
(produce_special_glyphs, produce_glyphs, write_glyphs)
(insert_glyphs): Remove.
(raw_cursor_to, clear_to_end, tty_turn_off_insert)
(tty_turn_off_highlight,get_tty_size): Add declaration.
(tabs_safe_p, init_baud_rate, get_tty_terminal): Update
prototypes.
* frame.h (enum output_method): Add output_initial.
(struct x_output): Delete.
(FRAME_FOREGROUND_PIXEL, FRAME_BACKGROUND_PIXEL): Access
foreground_pixel and background_pixel directly from the frame.
(tty_display): Delete.
(struct frame): Add buried_buffer_list, foreground_pixel,
background_pixel and terminal. Delete kboard
(union output_data): Add tty.
(FRAME_KBOARD): Get the kboard from the terminal.
(FRAME_INITIAL_P): New macro.
(Qtty, Qtty_type, Qterminal, Qterminal_live_p, Qenvironment)
(Qterm_environment_variable, Qdisplay_environment_variable)
(make_terminal_frame, Qburied_buffer_list, Qwindow_system): New
declarations.
* termchar.h (tty_output, tty_display_info): New structures.
(tty_list): Declare.
(FRAME_TTY, CURTTY): New macros.
(must_write_spaces, min_padding_speed, fast_clear_end_of_line)
(line_ins_del_ok, char_ins_del_ok, scroll_region_ok)
(scroll_region_cost, memory_below_frame, fast_clear_end_of_line)
(dont_calculate_costs, no_redraw_on_reenter): Remove declarations.
* callproc.c: Include frame.h and termhooks.h, for terminal
parameters.
(add_env): New function.
(child_setup): Use it.
(child_setup, getenv_internal): Handle the new
Vprocess_environment.
(getenv_internal): Fix get_terminal_param call.
(Fgetenv_internal, egetenv): Update doc.
(syms_of_callproc): Initialize Vprocess_environment to nil.
Register and initialize them. Remove obsolete defvars. Update doc
strings.
(child_setup): Handle Vlocal_environment_variables.
(getenv_internal): Add terminal parameter. Handle
Vlocal_environment_variables.
(Fgetenv_internal): Add terminal parameter.
(child_setup, getenv_internal, Fgetenv_internal): Store the local
environment in a frame (not terminal) parameter. Update doc
strings.
(set_initial_environment): Rename from set_global_environment.
Store Emacs environment in initial frame parameter.
* xdisp.c (redisplay_internal): Update references to
`previous_terminal_frame'.
(display_mode_line, Fformat_mode_line): Replace calls to
`push_frame_kboard' with `push_kboard'.
(get_glyph_string_clip_rects): Add extra parentheses and
braces to prevent compiler warnings.
(calc_pixel_width_or_height): Add xassert to check that the
frame is alive. Don't call `lookup_image' on a termcap frame.
(message2_nolog, message3_nolog, redisplay_internal)
(set_vertical_scroll_bar, redisplay_window, check_x_display_info)
(x_set_scroll_bar_foreground, x_set_scroll_bar_background)
(Fx_create_frame, Fxw_display_color_p, Fx_display_grayscale_p)
(Fx_display_pixel_width, Fx_display_pixel_height)
(Fx_display_planes, Fx_display_color_cells)
(Fx_server_max_request_size, Fx_server_vendor, Fx_server_version)
(Fx_display_screens, Fx_display_mm_height, Fx_display_mm_width)
(Fx_display_backing_store, Fx_display_visual_class)
(Fx_display_save_under, Fx_close_connection, x_create_tip_frame):
Use FRAME_TERMINAL_P, FRAME_WINDOW_P, FRAME_TTY and FRAME_RIF.
* xfns.c (x_set_foreground_color x_set_background_color)
(x_set_mouse_color, x_set_cursor_color, x_make_gc): Use
FRAME_BACKGROUND_PIXEL and FRAME_FOREGROUND_PIXEL.
(Fx_create_frame, x_create_tip_frame, build_string, x_window)
(Fx_create_frame, x_create_tip_frame): Don't create frames on a
terminal that is being deleted.
(Fx_create_frame): Use `store_frame_param' to set `window-system'
frame parameter, and make sure it overrides any user-supplied
setting.
(Fx_close_connection, Fx_synchronize): Unify argument names with
the rest of the DEFUNs.
* dispnew.c (Fsend_string_to_terminal): Update call to
`get_tty_terminal'.
(Fredraw_frame, Fsend_string_to_terminal)
(Fsend_string_to_terminal, init_display): User FRAME_RIF,
FRAME_TERMCAP_P and FRAME_TTY.
(window_change_signal): Don't believe width/height values that are
impossibly small.
(Vinitial_window_system): Rename from Vwindow_system.
(termscript, Wcm, rif): Delete.
* termhooks.h (struct terminal): New struct containing the
previously global text display hooks and new members NAME,
DELETED and PARAM_ALIST.
(FRAME_TERMINAL, TERMINAL_TERMINAL_CODING)
(TERMINAL_KEYBOARD_CODING, TERMINAL_ACTIVE_P, FRAME_WINDOW_P)
(FRAME_RIF): New macros.
(get_terminal_param, get_device): New declarations.
(termscript): Delete declaration.
* xterm.c (x_initialize): Use Fset_input_interrupt_mode.
(XTflash, x_free_frame_resources, x_scroll_bar_create)
(x_scroll_bar_set_handle): Use FRAME_BACKGROUND_PIXEL and
FRAME_FOREGROUND_PIXEL.
(x_fully_uncatch_errors): Disable definition.
(x_scroll_bar_expose): Fix reference to foreground pixel.
(XTread_socket): Disable loop on all X displays.
(x_delete_terminal): Don't set terminal->deleted and let
delete_terminal delete the frames on the terminal.
(x_delete_display): Doc update to reflect changes in
delete_terminal.
(x_display_info) <terminal>: Move member earlier in the struct.
(x_delete_terminal): Use terminal->deleted. Delete all frames on
the display explicitly.
(deleting_tty): Remove old variable.
(Fsuspend_tty): Call clear_tty_hooks.
(Fresume_tty, init_tty): Call set_tty_hooks.
(clear_tty_hooks, set_tty_hooks): New functions.
(Ftty_display_color_p, Ftty_display_color_cells): Don't throw
errors on X frames.
(x_catch_errors_unwind): Abort if x_error_message is NULL.
(handle_one_xevent): Initialize `f' to NULL.
(x_delete_device, x_create_device): New functions.
(XTset_terminal_modes, XTreset_terminal_modes)
(XTread_socket, x_connection_closed, x_term_init)
(x_term_init, x_delete_display): Add terminal parameter.
(x_term_init) [!HAVE_GTK_MULTIDISPLAY]: Refuse to create secondary
X connections.
* frame.c (Fframep): Deal with output_initial.
(Qbuffer_predicate, Qbuffer_list, Qburied_buffer_list, Qtty)
(Qtty_type, Qwindow_system, Qenvironment)
(Qterm_environment_variable, Qdisplay_environment_variable): New
variables.
(x_set_screen_gamma, store_frame_param): Fix compilation errors.
(make_terminal_frame): Don't create frames on a terminal that is
being deleted.
(make_terminal_frame): Use FRAME_BACKGROUND_PIXEL and
FRAME_FOREGROUND_PIXEL.
(store_frame_param): Check for found_for_frame before calling
XFRAME.
(Fmake_terminal_frame): Handle NULL tty names correctly.
(syms_of_frame): Enhance doc string of `default-frame-alist'.
(Fdelete_frame): Remove unused variable `count'.
(Qenvironment): New variable.
(Fdelete_frame): Don't allow other frames to refer to a deleted
frame in their 'environment parameter.
(Fframe_with_environment): New function.
(syms_of_frame): Defsubr it. Initialize and staticpro
Qenvironment.
(get_future_frame_param): New function.
(Fmake_terminal_frame): Use it.
* sysdep.c (init_sys_modes, reset_sys_modes): Update for renames.
* sysdep.c (reset_sys_modes): Update for renames.
* keyboard.c (tty_read_avail_input): New function.
(Fset_input_interrupt_mode,Fset_output_flow_control): New
functions.
(syms_of_keyboard): Defsubr them.
(Fset_input_meta_mode, Fset_quit_char): New functions.
(Fset_input_mode): Split to above functions.
(read_char_minibuf_menu_prompt): Add wrong_kboard_jmpbuf
parameter. Use it in call to `read_char'.
(read_char): Declare. Update call to
`read_char_minibuf_menu_prompt'. Set wrong_kboard_jmpbuf
correctly in recursive calls. Use current_kboard to access
Vkeyboard_translate_table. Enhance comment before extra longjmp
to wrong_kboard_jmpbuf. Add wrong_kboard_jmpbuf parameter to
allow for recursive calls. Update longjmp invocations. Remember
the original current_kboard, and longjmp to `wrong_kboard_jmpbuf'
when a filter, timer or sentinel changes it. Comment out
unnecessary calls to `record_single_kboard_state' and
`any_kboard_state'. Update recursive calls.
(wrong_kboard_jmpbuf): Remove global variable.
(read_key_sequence): Remove unused variable wrong_kboard_jmpbuf.
Handle deleted interrupted_kboards correctly; that is a legal
case. Add `wrong_kboard_jmpbuf' local variable. Update setjmp
and read_char calls. Abort if interrupted_kboard died in
read_char.
(any_kboard_state, single_kboard_state)
(push_frame_kboard): Remove function.
(pop_kboard): Switch out of single_kboard mode if the kboard has
been deleted. Remove unused variable. Help debugging by not
changing current_kboard unnecessarily. Set current_kboard to the
kboard of the selected frame when the stored kboard object has
been deleted before pop_kboard.
(temporarily_switch_to_single_kboard): Change first parameter to a
frame pointer. Throw an error when caller wants to change kboards
while in single_kboard mode. Don't push_kboard if we weren't in
single kboard state. Don't pop_kboard if we popped into any
kboard state.
(restore_kboard_configuration): Abort if pop_kboard changed the
kboard in single_kboard mode. Call pop_kboard only after setting
up single_kboard mode.
(Frecursive_edit): Switch to single_kboard mode only in nested
command loops.
(cmd_error, command_loop, command_loop_1, timer_check): Comment
out unnecessary call to `any_kboard_state' and
`record_single_kboard_state'.
(delete_kboard): Exit single_kboard mode if we have just deleted
that kboard. Use FRAME_KBOARD.
(interrupt_signal): Use `Fkill_emacs' to exit Emacs, not
`fatal_error_signal'.
(record_single_kboard_state): Don't push_kboard if we weren't in
single kboard state. Don't pop_kboard if we popped into any
kboard state.
(push_frame_kboard): Rename to push_kboard.
(kbd_buffer_get_event): Use FRAME_TERMINAL.
(read_avail_input): Read input from all terminals.
(mark_kboards): Also mark Vkeyboard_translate_table.
(kbd_buffer_store_event_hold): Simplify condition.
(read_key_sequence): Reinitialize fkey and keytran at each replay.
(Vkeyboard_translate_table): Move to struct kboard.
(init_kboard): Initialize Vkeyboard_translate_table.
(syms_of_keyboard): Use DEFVAR_KBOARD to define
Vkeyboard_translate_table. Update doc strings. Update docs of
local-function-key-map and function-key-map.
* terminal.c: New file.
* term.c: Include errno.h.
(Vring_bell_function, device_list, initial_device)
(next_device_id, ring_bell, update_begin, update_end)
(set_terminal_window, cursor_to, raw_cursor_to)
(clear_to_end, clear_frame, clear_end_of_line)
(write_glyphs, insert_glyphs, delete_glyphs, ins_del_lines)
(Fdisplay_name, create_device, delete_device): Move to terminal.c.
(syms_of_term): Move their initialization to terminal.c.
(get_tty_terminal, Fdisplay_tty_type, Ftty_display_color_p)
(Ftty_display_color_cells)
(Ftty_no_underline, Fsuspend_tty, Fresume_tty, create_tty_output)
(init_tty, maybe_fatal): New functions.
(Ftty_type): Return nil if terminal is not on a tty instead of
throwing an error. Doc update.
(syms_of_term) <Vsuspend_tty_functions, Vresume_tty_functions>:
Doc update. Initialize new subrs and variables.
(delete_tty): Use terminal->deleted.
(tty_set_terminal_modes): Rename from set_terminal_modes.
(tty_reset_terminal_modes): Rename from reset_terminal_modes.
(set_scroll_region): Rename to `tty_set_scroll_region'.
(turn_on_insert): Rename to `tty_turn_on_insert'.
(turn_off_insert): Rename to `tty_turn_off_insert'.
(turn_off_highlight): Rename to `tty_turn_off_highlight'.
(turn_on_highlight): Rename to `tty_turn_on_highlight'.
(toggle_highligh): Rename to `tty_toggle_highlight'.
(background_highlight): Rename to `tty_background_highlight'.
(highlight_if_desired): Rename to `tty_highlight_if_desired'.
(tty_ring_bell, tty_update_end, tty_set_terminal_window)
(tty_set_scroll_region, tty_background_highlight)
(tty_cursor_to, tty_raw_cursor_to, tty_clear_to_end)
(tty_clear_frame, tty_clear_end_of_line, tty_write_glyphs)
(tty_insert_glyphs, tty_delete_glyphs, tty_ins_del_lines)
(term_get_fkeys, tty_setup_colors, dissociate_if_controlling_tty):
Add static modifier.
(tty_reset_terminal_modes, tty_set_terminal_window)
(tty_set_scroll_region, tty_background_highlight)
(tty_highlight_if_desired, tty_cursor_to)
(tty_raw_cursor_to, tty_clear_to_end, tty_clear_frame)
(tty_clear_end_of_line, tty_write_glyphs, tty_insert_glyphs)
(tty_delete_glyphs, tty_ins_del_lines, turn_on_face): Update for
renames.
2007-08-28 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* keyboard.c: Qrtl is new.

57
src/Makefile.in
View file

@ -595,7 +595,7 @@ emacsappsrc = ${srcdir}/../mac/Emacs.app/
whose initialized data areas should be dumped as pure by dump-emacs. */
obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \
charset.o coding.o category.o ccl.o \
cm.o term.o xfaces.o $(XOBJ) $(GTK_OBJ)\
cm.o term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ)\
emacs.o keyboard.o macros.o keymap.o sysdep.o \
buffer.o filelock.o insdel.o marker.o \
minibuf.o fileio.o dired.o filemode.o \
@ -741,6 +741,7 @@ otherobj= $(termcapobj) lastfile.o $(mallocobj) $(allocaobj) $(widgetobj) $(LIBO
lisp= \
${lispsource}abbrev.elc \
${lispsource}buff-menu.elc \
${lispsource}server.elc \
${lispsource}button.elc \
${lispsource}emacs-lisp/byte-run.elc \
${lispsource}cus-face.elc \
@ -757,6 +758,7 @@ lisp= \
MOUSE_SUPPORT \
${lispsource}emacs-lisp/float-sup.elc \
${lispsource}frame.elc \
${lispsource}termdev.elc \
${lispsource}help.elc \
${lispsource}indent.elc \
${lispsource}isearch.elc \
@ -840,6 +842,7 @@ lisp= \
shortlisp= \
../lisp/abbrev.elc \
../lisp/buff-menu.elc \
../lisp/server.elc \
../lisp/button.elc \
../lisp/emacs-lisp/byte-run.elc \
../lisp/cus-face.elc \
@ -854,6 +857,7 @@ shortlisp= \
../lisp/emacs-lisp/float-sup.elc \
../lisp/format.elc \
../lisp/frame.elc \
../lisp/termdev.elc \
../lisp/help.elc \
../lisp/indent.elc \
../lisp/isearch.elc \
@ -943,7 +947,9 @@ SOME_MACHINE_LISP = ${dotdot}/lisp/mouse.elc \
${dotdot}/lisp/x-dnd.elc \
${dotdot}/lisp/international/ccl.elc \
${dotdot}/lisp/international/codepage.elc \
${dotdot}/lisp/international/fontset.elc
${dotdot}/lisp/international/fontset.elc \
${dotdot}/lisp/mouse.elc \
${dotdot}/lisp/term/x-win.elc
/* Construct full set of libraries to be linked.
Note that SunOS needs -lm to come before -lc; otherwise, you get
@ -989,7 +995,7 @@ emacs${EXEEXT}: temacs${EXEEXT} ${etc}DOC ${lisp}
for the first time, this prevents any variation between configurations
in the contents of the DOC file.
Likewise for ${SOME_MACHINE_LISP}. */
${etc}DOC: ${libsrc}make-docfile${EXEEXT} ${obj} ${shortlisp} ${SOME_MACHINE_LISP}
${etc}DOC: ${libsrc}make-docfile ${obj} ${shortlisp} ${SOME_MACHINE_LISP}
-rm -f ${etc}DOC
${libsrc}make-docfile -d ${srcdir} ${SOME_MACHINE_OBJECTS} ${obj} > ${etc}DOC
${libsrc}make-docfile -a ${etc}DOC -d ${srcdir} ${SOME_MACHINE_LISP} ${shortlisp}
@ -1112,7 +1118,7 @@ callint.o: callint.c window.h commands.h buffer.h keymap.h \
keyboard.h dispextern.h $(config_h)
callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \
composite.h w32.h blockinput.h atimer.h systime.h
composite.h w32.h blockinput.h atimer.h systime.h frame.h termhooks.h
casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \
charset.h keymap.h $(config_h)
casetab.o: casetab.c buffer.h $(config_h)
@ -1121,8 +1127,8 @@ ccl.o: ccl.c ccl.h charset.h coding.h $(config_h)
charset.o: charset.c charset.h buffer.h coding.h composite.h disptab.h \
$(config_h)
coding.o: coding.c coding.h ccl.h buffer.h charset.h intervals.h composite.h \
window.h dispextern.h $(config_h)
cm.o: cm.c cm.h termhooks.h $(config_h)
window.h dispextern.h frame.h termhooks.h $(config_h)
cm.o: cm.c frame.h cm.h termhooks.h termchar.h $(config_h)
cmds.o: cmds.c syntax.h buffer.h charset.h commands.h window.h $(config_h) \
msdos.h dispextern.h keyboard.h keymap.h
pre-crt0.o: pre-crt0.c
@ -1130,7 +1136,7 @@ ecrt0.o: ecrt0.c $(config_h)
CRT0_COMPILE ${srcdir}/ecrt0.c
dired.o: dired.c commands.h buffer.h $(config_h) charset.h coding.h regex.h \
systime.h blockinput.h atimer.h
dispnew.o: dispnew.c systty.h systime.h commands.h process.h frame.h \
dispnew.o: dispnew.c systime.h commands.h process.h frame.h \
window.h buffer.h dispextern.h termchar.h termopts.h termhooks.h cm.h \
disptab.h indent.h intervals.h \
xterm.h blockinput.h atimer.h charset.h msdos.h composite.h keyboard.h \
@ -1151,10 +1157,10 @@ filelock.o: filelock.c buffer.h charset.h coding.h systime.h epaths.h $(config_h
filemode.o: filemode.c $(config_h)
frame.o: frame.c xterm.h window.h frame.h termhooks.h commands.h keyboard.h \
blockinput.h atimer.h systime.h buffer.h charset.h fontset.h \
msdos.h dosfns.h dispextern.h w32term.h macterm.h $(config_h)
fringe.o: fringe.c dispextern.h frame.h window.h buffer.h $(config_h)
msdos.h dosfns.h dispextern.h w32term.h macterm.h termchar.h $(config_h)
fringe.o: fringe.c dispextern.h frame.h window.h buffer.h termhooks.h $(config_h)
fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h charset.h frame.h \
keyboard.h $(config_h)
keyboard.h termhooks.h $(config_h)
getloadavg.o: getloadavg.c $(config_h)
image.o: image.c frame.h window.h dispextern.h blockinput.h atimer.h \
systime.h xterm.h w32term.h w32gui.h macterm.h macgui.h $(config_h)
@ -1165,7 +1171,7 @@ insdel.o: insdel.c window.h buffer.h $(INTERVAL_SRC) blockinput.h charset.h \
dispextern.h atimer.h systime.h region-cache.h $(config_h)
keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h charset.h \
commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \
systty.h systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
atimer.h xterm.h puresize.h msdos.h keymap.h w32term.h macterm.h $(config_h)
keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \
atimer.h systime.h puresize.h charset.h intervals.h keymap.h window.h \
@ -1180,7 +1186,8 @@ vm-limit.o: vm-limit.c mem-limits.h $(config_h)
marker.o: marker.c buffer.h charset.h $(config_h)
md5.o: md5.c md5.h $(config_h)
minibuf.o: minibuf.c syntax.h dispextern.h frame.h window.h keyboard.h \
buffer.h commands.h charset.h msdos.h $(INTERVAL_SRC) keymap.h $(config_h)
buffer.h commands.h charset.h msdos.h $(INTERVAL_SRC) keymap.h \
termhooks.h $(config_h)
mktime.o: mktime.c $(config_h)
msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h frame.h \
termopts.h termchar.h charset.h coding.h ccl.h disptab.h window.h \
@ -1192,7 +1199,7 @@ process.o: process.c process.h buffer.h window.h termhooks.h termopts.h \
regex.o: regex.c syntax.h buffer.h $(config_h) regex.h category.h charset.h
region-cache.o: region-cache.c buffer.h region-cache.h $(config_h)
scroll.o: scroll.c termchar.h dispextern.h frame.h msdos.h keyboard.h \
$(config_h)
termhooks.h $(config_h)
search.o: search.c regex.h commands.h buffer.h region-cache.h syntax.h \
blockinput.h atimer.h systime.h category.h charset.h composite.h \
$(INTERVAL_SRC) $(config_h)
@ -1201,11 +1208,13 @@ syntax.o: syntax.c syntax.h buffer.h commands.h category.h charset.h \
composite.h keymap.h regex.h $(INTERVAL_SRC) $(config_h)
sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \
process.h dispextern.h termhooks.h termchar.h termopts.h \
frame.h atimer.h window.h msdos.h dosfns.h keyboard.h $(config_h)
frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h $(config_h)
term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \
disptab.h dispextern.h keyboard.h charset.h coding.h ccl.h msdos.h \
window.h keymap.h blockinput.h atimer.h systime.h
termcap.o: termcap.c $(config_h)
terminal.o: terminal.c frame.h termchar.h termhooks.h charset.h coding.h \
keyboard.h $(config_h)
terminfo.o: terminfo.c $(config_h)
tparam.o: tparam.c $(config_h)
undo.o: undo.c buffer.h commands.h window.h $(config_h)
@ -1218,7 +1227,7 @@ w16select.o: w16select.c dispextern.h frame.h blockinput.h atimer.h systime.h \
widget.o: widget.c xterm.h frame.h dispextern.h widgetprv.h \
$(srcdir)/../lwlib/lwlib.h $(config_h)
window.o: window.c indent.h commands.h frame.h window.h buffer.h termchar.h \
termhooks.h disptab.h keyboard.h dispextern.h msdos.h composite.h \
disptab.h keyboard.h dispextern.h msdos.h composite.h \
keymap.h blockinput.h atimer.h systime.h $(INTERVAL_SRC) \
xterm.h w32term.h macterm.h $(config_h)
xdisp.o: xdisp.c macros.h commands.h process.h indent.h buffer.h dispextern.h coding.h \
@ -1227,10 +1236,11 @@ xdisp.o: xdisp.c macros.h commands.h process.h indent.h buffer.h dispextern.h co
msdos.h composite.h fontset.h blockinput.h atimer.h systime.h keymap.h
xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \
window.h charset.h msdos.h dosfns.h composite.h atimer.h systime.h \
keyboard.h fontset.h w32term.h macterm.h $(INTERVAL_SRC) $(config_h)
keyboard.h fontset.h w32term.h macterm.h $(INTERVAL_SRC) termchar.h \
termhooks.h $(config_h)
xfns.o: xfns.c buffer.h frame.h window.h keyboard.h xterm.h dispextern.h \
$(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h epaths.h \
charset.h gtkutil.h $(config_h)
charset.h gtkutil.h termchar.h termhooks.h $(config_h)
xmenu.o: xmenu.c xterm.h termhooks.h window.h dispextern.h frame.h buffer.h \
keyboard.h $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h \
gtkutil.h msdos.h coding.h $(config_h)
@ -1239,7 +1249,7 @@ xterm.o: xterm.c xterm.h termhooks.h termopts.h termchar.h window.h buffer.h \
keyboard.h gnu.h charset.h ccl.h fontset.h composite.h \
coding.h process.h gtkutil.h $(config_h)
xselect.o: xselect.c process.h dispextern.h frame.h xterm.h blockinput.h \
buffer.h atimer.h systime.h $(config_h)
buffer.h atimer.h systime.h termhooks.h $(config_h)
xrdb.o: xrdb.c $(config_h) epaths.h
xsmfns.o: xsmfns.c $(config_h) systime.h sysselect.h termhooks.h xterm.h \
lisp.h termopts.h
@ -1257,19 +1267,18 @@ alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h key
blockinput.h atimer.h systime.h charset.h dispextern.h $(config_h) $(INTERVAL_SRC)
bytecode.o: bytecode.c buffer.h syntax.h charset.h window.h dispextern.h \
frame.h xterm.h $(config_h)
data.o: data.c buffer.h puresize.h charset.h syssignal.h keyboard.h frame.h $(config_h)
data.o: data.c buffer.h puresize.h charset.h syssignal.h keyboard.h frame.h termhooks.h $(config_h)
eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h \
dispextern.h $(config_h)
floatfns.o: floatfns.c $(config_h)
fns.o: fns.c commands.h $(config_h) frame.h buffer.h charset.h keyboard.h \
keymap.h frame.h window.h dispextern.h $(INTERVAL_SRC) coding.h md5.h \
blockinput.h atimer.h systime.h xterm.h
blockinput.h atimer.h systime.h xterm.h termhooks.h
print.o: print.c process.h frame.h window.h buffer.h keyboard.h charset.h \
$(config_h) dispextern.h termchar.h $(INTERVAL_SRC) msdos.h composite.h \
blockinput.h atimer.h systime.h
lread.o: lread.c commands.h keyboard.h buffer.h epaths.h charset.h \
$(config_h) $(INTERVAL_SRC) termhooks.h coding.h msdos.h blockinput.h \
atimer.h systime.h
$(config_h) $(INTERVAL_SRC) termhooks.h coding.h msdos.h
/* Text properties support */
textprop.o: textprop.c buffer.h window.h dispextern.h $(INTERVAL_SRC) \
@ -1282,12 +1291,12 @@ composite.o: composite.c buffer.h charset.h $(INTERVAL_SRC) $(config_h)
OTHER_FILES and OBJECTS_MACHINE
select which of these should be compiled. */
sunfns.o: sunfns.c buffer.h window.h dispextern.h $(config_h)
sunfns.o: sunfns.c buffer.h window.h dispextern.h termhooks.h $(config_h)
#ifdef HAVE_CARBON
abbrev.o buffer.o callint.o cmds.o dispnew.o editfns.o fileio.o frame.o \
fontset.o indent.o insdel.o keyboard.o macros.o minibuf.o msdos.o process.o \
scroll.o sysdep.o term.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \
scroll.o sysdep.o term.o terminal.o widget.o window.o xdisp.o xfaces.o xfns.o xmenu.o \
xterm.o xselect.o sound.o: macgui.h
mac.o: mac.c process.h sysselect.h blockinput.h atimer.h systime.h charset.h \
coding.h ccl.h $(config_h)

8
src/alloc.c
View file

@ -341,7 +341,9 @@ Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */
EMACS_INT gcs_done; /* accumulated GCs */
static void mark_buffer P_ ((Lisp_Object));
extern void mark_terminals P_ ((void));
extern void mark_kboards P_ ((void));
extern void mark_ttys P_ ((void));
extern void mark_backtrace P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
@ -1234,7 +1236,8 @@ emacs_blocked_malloc (size, ptr)
BLOCK_INPUT_ALLOC;
__malloc_hook = old_malloc_hook;
#ifdef DOUG_LEA_MALLOC
mallopt (M_TOP_PAD, malloc_hysteresis * 4096);
/* Segfaults on my system. --lorentey */
/* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */
#else
__malloc_extra_blocks = malloc_hysteresis;
#endif
@ -5170,7 +5173,9 @@ returns nil, because real GC can't be done. */)
mark_object (bind->symbol);
mark_object (bind->old_value);
}
mark_terminals ();
mark_kboards ();
mark_ttys ();
#ifdef USE_GTK
{
@ -5605,6 +5610,7 @@ mark_object (arg)
mark_object (ptr->menu_bar_vector);
mark_object (ptr->buffer_predicate);
mark_object (ptr->buffer_list);
mark_object (ptr->buried_buffer_list);
mark_object (ptr->menu_bar_window);
mark_object (ptr->tool_bar_window);
mark_face_cache (ptr->face_cache);

48
src/buffer.c
View file

@ -215,25 +215,38 @@ frame parameter come first, followed by the rest of the buffers. */)
(frame)
Lisp_Object frame;
{
Lisp_Object framelist, general;
Lisp_Object general;
general = Fmapcar (Qcdr, Vbuffer_alist);
if (FRAMEP (frame))
{
Lisp_Object tail;
Lisp_Object framelist, prevlist, tail;
Lisp_Object args[3];
CHECK_FRAME (frame);
framelist = Fcopy_sequence (XFRAME (frame)->buffer_list);
prevlist = Fnreverse (Fcopy_sequence (XFRAME (frame)->buried_buffer_list));
/* Remove from GENERAL any buffer that duplicates one in FRAMELIST. */
/* Remove from GENERAL any buffer that duplicates one in
FRAMELIST or PREVLIST. */
tail = framelist;
while (! NILP (tail))
while (CONSP (tail))
{
general = Fdelq (XCAR (tail), general);
tail = XCDR (tail);
}
return nconc2 (framelist, general);
tail = prevlist;
while (CONSP (tail))
{
general = Fdelq (XCAR (tail), general);
tail = XCDR (tail);
}
args[0] = framelist;
args[1] = general;
args[2] = prevlist;
return Fnconc (3, args);
}
return general;
@ -1583,6 +1596,23 @@ record_buffer (buf)
XSETCDR (link, Vbuffer_alist);
Vbuffer_alist = link;
/* Effectively do a delq on buried_buffer_list. */
prev = Qnil;
for (link = XFRAME (frame)->buried_buffer_list; CONSP (link);
link = XCDR (link))
{
if (EQ (XCAR (link), buf))
{
if (NILP (prev))
XFRAME (frame)->buried_buffer_list = XCDR (link);
else
XSETCDR (prev, XCDR (XCDR (prev)));
break;
}
prev = link;
}
/* Now move this buffer to the front of frame_buffer_list also. */
prev = Qnil;
@ -2065,10 +2095,10 @@ selected window if it is displayed there. */)
XSETCDR (link, Qnil);
Vbuffer_alist = nconc2 (Vbuffer_alist, link);
/* Removing BUFFER from frame-specific lists
has the effect of putting BUFFER at the end
of the combined list in each frame. */
frames_discard_buffer (buffer);
XFRAME (selected_frame)->buffer_list
= Fdelq (buffer, XFRAME (selected_frame)->buffer_list);
XFRAME (selected_frame)->buried_buffer_list
= Fcons (buffer, Fdelq (buffer, XFRAME (selected_frame)->buried_buffer_list));
}
return Qnil;

7
src/callint.c
View file

@ -402,8 +402,8 @@ invoke it. If KEYS is omitted or nil, the return value of
real_this_command= save_real_this_command;
current_kboard->Vlast_command = save_last_command;
single_kboard_state ();
return apply1 (function, specs);
temporarily_switch_to_single_kboard (NULL);
return unbind_to (speccount, apply1 (function, specs));
}
/* Here if function specifies a string to control parsing the defaults */
@ -854,12 +854,11 @@ invoke it. If KEYS is omitted or nil, the return value of
real_this_command= save_real_this_command;
current_kboard->Vlast_command = save_last_command;
single_kboard_state ();
{
Lisp_Object val;
specbind (Qcommand_debug_status, Qnil);
temporarily_switch_to_single_kboard (NULL);
val = Ffuncall (count + 1, args);
UNGCPRO;
return unbind_to (speccount, val);

316
src/callproc.c
View file

@ -84,6 +84,8 @@ extern int errno;
#include "syssignal.h"
#include "systty.h"
#include "blockinput.h"
#include "frame.h"
#include "termhooks.h"
#ifdef MSDOS
#include "msdos.h"
@ -130,6 +132,7 @@ int synch_process_termsig;
/* If synch_process_death is zero,
this is exit code of synchronous subprocess. */
int synch_process_retcode;
/* Clean up when exiting Fcall_process.
On MSDOS, delete the temporary file on any kind of termination.
@ -1181,6 +1184,40 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
static int relocate_fd ();
static char **
add_env (char **env, char **new_env, char *string)
{
char **ep;
int ok = 1;
if (string == NULL)
return new_env;
/* See if this string duplicates any string already in the env.
If so, don't put it in.
When an env var has multiple definitions,
we keep the definition that comes first in process-environment. */
for (ep = env; ok && ep != new_env; ep++)
{
char *p = *ep, *q = string;
while (ok)
{
if (*q != *p)
break;
if (*q == 0)
/* The string is a lone variable name; keep it for now, we
will remove it later. It is a placeholder for a
variable that is not to be included in the environment. */
break;
if (*q == '=')
ok = 0;
p++, q++;
}
}
if (ok)
*new_env++ = string;
return new_env;
}
/* This is the last thing run in a newly forked inferior
either synchronous or asynchronous.
Copy descriptors IN, OUT and ERR as descriptors 0, 1 and 2.
@ -1208,6 +1245,8 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
{
char **env;
char *pwd_var;
char *term_var;
char *display_var;
#ifdef WINDOWSNT
int cpid;
HANDLE handles[3];
@ -1282,57 +1321,101 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir)
temp[--i] = 0;
}
/* Set `env' to a vector of the strings in Vprocess_environment. */
/* Set `env' to a vector of the strings in the environment. */
{
register Lisp_Object tem;
register char **new_env;
char **p, **q;
register int new_length;
Lisp_Object local = selected_frame; /* get_frame_param (XFRAME (Fframe_with_environment (selected_frame)), */
/* Qenvironment); */
Lisp_Object term;
Lisp_Object display;
new_length = 0;
for (tem = Vprocess_environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
new_length++;
#if 0
for (tem = local;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
new_length++;
#endif
/* Add TERM and DISPLAY from the frame local values. */
term = get_frame_param (XFRAME (local), Qterm_environment_variable);
if (! NILP (term))
new_length++;
display = get_frame_param (XFRAME (local), Qdisplay_environment_variable);
if (! NILP (display))
new_length++;
/* new_length + 2 to include PWD and terminating 0. */
env = new_env = (char **) alloca ((new_length + 2) * sizeof (char *));
/* If we have a PWD envvar, pass one down,
but with corrected value. */
if (getenv ("PWD"))
if (egetenv ("PWD"))
*new_env++ = pwd_var;
if (! NILP (term))
{
int vlen = strlen ("TERM=") + strlen (SDATA (term)) + 1;
char *vdata = (char *) alloca (vlen);
strcpy (vdata, "TERM=");
strcat (vdata, SDATA (term));
new_env = add_env (env, new_env, vdata);
}
/* Copy the Vprocess_environment strings into new_env. */
if (! NILP (display))
{
int vlen = strlen ("DISPLAY=") + strlen (SDATA (display)) + 1;
char *vdata = (char *) alloca (vlen);
strcpy (vdata, "DISPLAY=");
strcat (vdata, SDATA (display));
new_env = add_env (env, new_env, vdata);
}
/* Overrides. */
for (tem = Vprocess_environment;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
{
char **ep = env;
char *string = (char *) SDATA (XCAR (tem));
/* See if this string duplicates any string already in the env.
If so, don't put it in.
When an env var has multiple definitions,
we keep the definition that comes first in process-environment. */
for (; ep != new_env; ep++)
{
char *p = *ep, *q = string;
while (1)
{
if (*q == 0)
/* The string is malformed; might as well drop it. */
goto duplicate;
if (*q != *p)
break;
if (*q == '=')
goto duplicate;
p++, q++;
}
}
*new_env++ = string;
duplicate: ;
if ((strcmp (SDATA (XCAR (tem)), "TERM") != 0)
&& (strcmp (SDATA (XCAR (tem)), "DISPLAY") != 0))
new_env = add_env (env, new_env, SDATA (XCAR (tem)));
}
#if 0
/* Local part of environment. */
for (tem = local;
CONSP (tem) && STRINGP (XCAR (tem));
tem = XCDR (tem))
new_env = add_env (env, new_env, SDATA (XCAR (tem)));
#endif
*new_env = 0;
/* Remove variable names without values. */
p = q = env;
while (*p != 0)
{
while (*q != 0 && strchr (*q, '=') == NULL)
*q++;
*p = *q++;
if (*p != 0)
p++;
}
}
#ifdef WINDOWSNT
prepare_standard_handles (in, out, err, handles);
set_process_dir (SDATA (current_dir));
@ -1446,59 +1529,160 @@ relocate_fd (fd, minfd)
}
static int
getenv_internal (var, varlen, value, valuelen)
getenv_internal (var, varlen, value, valuelen, frame)
char *var;
int varlen;
char **value;
int *valuelen;
Lisp_Object frame;
{
Lisp_Object scan;
Lisp_Object term;
Lisp_Object display;
for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
if (NILP (frame))
{
/* Try to find VAR in Vprocess_environment first. */
for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
{
Lisp_Object entry = XCAR (scan);
if (STRINGP (entry)
&& SBYTES (entry) >= varlen
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
&& ! strnicmp (SDATA (entry), var, varlen)
#else /* not WINDOWSNT */
&& ! bcmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
)
{
if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
{
*value = (char *) SDATA (entry) + (varlen + 1);
*valuelen = SBYTES (entry) - (varlen + 1);
return 1;
}
else if (SBYTES (entry) == varlen)
{
/* Lone variable names in Vprocess_environment mean that
variable should be removed from the environment. */
return 0;
}
}
}
frame = selected_frame;
}
/* For TERM and DISPLAY first try to get the values from the frame. */
term = get_frame_param (XFRAME (frame), Qterm_environment_variable);
if (strcmp (var, "TERM") == 0)
if (! NILP (term))
{
*value = (char *) SDATA (term);
*valuelen = SBYTES (term);
return 1;
}
display = get_frame_param (XFRAME (frame), Qdisplay_environment_variable);
if (strcmp (var, "DISPLAY") == 0)
if (! NILP (display))
{
*value = (char *) SDATA (display);
*valuelen = SBYTES (display);
return 1;
}
{
/* Try to find VAR in Vprocess_environment. */
for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan))
{
Lisp_Object entry = XCAR (scan);
if (STRINGP (entry)
&& SBYTES (entry) >= varlen
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
&& ! strnicmp (SDATA (entry), var, varlen)
#else /* not WINDOWSNT */
&& ! bcmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
)
{
if (SBYTES (entry) > varlen && SREF (entry, varlen) == '=')
{
*value = (char *) SDATA (entry) + (varlen + 1);
*valuelen = SBYTES (entry) - (varlen + 1);
return 1;
}
else if (SBYTES (entry) == varlen)
{
/* Lone variable names in Vprocess_environment mean that
variable should be removed from the environment. */
return 0;
}
}
}
}
#if 0
/* Find the environment in which to search the variable. */
CHECK_FRAME (frame);
frame = Fframe_with_environment (frame);
for (scan = get_frame_param (XFRAME (frame), Qenvironment);
CONSP (scan);
scan = XCDR (scan))
{
Lisp_Object entry;
entry = XCAR (scan);
if (STRINGP (entry)
&& SBYTES (entry) > varlen
&& SREF (entry, varlen) == '='
&& SBYTES (entry) > varlen
&& SREF (entry, varlen) == '='
#ifdef WINDOWSNT
/* NT environment variables are case insensitive. */
&& ! strnicmp (SDATA (entry), var, varlen)
/* NT environment variables are case insensitive. */
&& ! strnicmp (SDATA (entry), var, varlen)
#else /* not WINDOWSNT */
&& ! bcmp (SDATA (entry), var, varlen)
&& ! bcmp (SDATA (entry), var, varlen)
#endif /* not WINDOWSNT */
)
)
{
*value = (char *) SDATA (entry) + (varlen + 1);
*valuelen = SBYTES (entry) - (varlen + 1);
return 1;
}
}
#endif
return 0;
}
DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 1, 0,
doc: /* Return the value of environment variable VAR, as a string.
VAR should be a string. Value is nil if VAR is undefined in the environment.
This function consults the variable `process-environment' for its value. */)
(var)
Lisp_Object var;
DEFUN ("getenv-internal", Fgetenv_internal, Sgetenv_internal, 1, 2, 0,
doc: /* 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 searches `process-environment' for VARIABLE. If it is
not found there, then it continues the search in the environment list
of the selected frame.
If optional parameter FRAME is non-nil, then this function will ignore
`process-environment' and will simply look up the variable in that
frame's environment. */)
(variable, frame)
Lisp_Object variable, frame;
{
char *value;
int valuelen;
CHECK_STRING (var);
if (getenv_internal (SDATA (var), SBYTES (var),
&value, &valuelen))
CHECK_STRING (variable);
if (getenv_internal (SDATA (variable), SBYTES (variable),
&value, &valuelen, frame))
return make_string (value, valuelen);
else
return Qnil;
}
/* A version of getenv that consults process_environment, easily
callable from C. */
/* A version of getenv that consults the Lisp environment lists,
easily callable from C. */
char *
egetenv (var)
char *var;
@ -1506,7 +1690,7 @@ egetenv (var)
char *value;
int valuelen;
if (getenv_internal (var, strlen (var), &value, &valuelen))
if (getenv_internal (var, strlen (var), &value, &valuelen, Qnil))
return value;
else
return 0;
@ -1629,8 +1813,8 @@ init_callproc ()
{
char *dir = getenv ("TMPDIR");
Vtemp_file_name_pattern
= Fexpand_file_name (build_string ("emacsXXXXXX"),
build_string (dir));
= Fexpand_file_name (build_string ("emacsXXXXXX"),
build_string (dir));
}
else
Vtemp_file_name_pattern = build_string ("/tmp/emacsXXXXXX");
@ -1646,17 +1830,19 @@ init_callproc ()
}
void
set_process_environment ()
set_initial_environment ()
{
register char **envp;
Vprocess_environment = Qnil;
Lisp_Object env = Vprocess_environment;
#ifndef CANNOT_DUMP
if (initialized)
#endif
for (envp = environ; *envp; envp++)
Vprocess_environment = Fcons (build_string (*envp),
Vprocess_environment);
{
for (envp = environ; *envp; envp++)
Vprocess_environment = Fcons (build_string (*envp),
Vprocess_environment);
store_frame_param (SELECTED_FRAME(), Qenvironment, Vprocess_environment);
}
}
void
@ -1716,15 +1902,27 @@ This is used by `call-process-region'. */);
/* This variable is initialized in init_callproc. */
DEFVAR_LISP ("process-environment", &Vprocess_environment,
doc: /* List of environment variables for subprocesses to inherit.
doc: /* List of overridden environment variables for subprocesses to inherit.
Each element should be a string of the form ENVVARNAME=VALUE.
Entries in this list take precedence to those in the frame-local
environments. Therefore, let-binding `process-environment' is an easy
way to temporarily change the value of an environment variable,
irrespective of where it comes from. To use `process-environment' to
remove an environment variable, include only its name in the list,
without "=VALUE".
This variable is set to nil when Emacs starts.
If multiple entries define the same variable, the first one always
takes precedence.
The environment which Emacs inherits is placed in this variable
when Emacs starts.
Non-ASCII characters are encoded according to the initial value of
`locale-coding-system', i.e. the elements must normally be decoded for use.
`locale-coding-system', i.e. the elements must normally be decoded for
use.
See `setenv' and `getenv'. */);
Vprocess_environment = Qnil;
#ifndef VMS
defsubr (&Scall_process);

216
src/cm.c
View file

@ -23,8 +23,13 @@ Boston, MA 02110-1301, USA. */
#include <config.h>
#include <stdio.h>
#include "lisp.h"
#include "frame.h"
#include "cm.h"
#include "termhooks.h"
#include "termchar.h"
/* For now, don't try to include termcap.h. On some systems,
configure finds a non-standard termcap.h that the main build
@ -53,13 +58,16 @@ evalcost (c)
return c;
}
/* The terminal to use for low-level output. */
struct tty_display_info *current_tty;
int
cmputc (c)
char c;
{
if (termscript)
fputc (c & 0177, termscript);
putchar (c & 0177);
if (current_tty->termscript)
putc (c & 0177, current_tty->termscript);
putc (c & 0177, current_tty->output);
return c;
}
@ -72,9 +80,9 @@ cmputc (c)
*/
static
at (row, col) {
curY = row;
curX = col;
at (tty, row, col) {
curY (tty) = row;
curX (tty) = col;
}
/*
@ -82,8 +90,8 @@ at (row, col) {
*/
static
addcol (n) {
curX += n;
addcol (tty, n) {
curX (tty) += n;
/*
* If cursor hit edge of screen, what happened?
@ -93,21 +101,21 @@ addcol (n) {
* of the last line.
*/
if (curX == Wcm.cm_cols) {
if (curX (tty) == tty->Wcm->cm_cols) {
/*
* Well, if magicwrap, still there, past the edge of the
* screen (!). If autowrap, on the col 0 of the next line.
* Otherwise on last column.
*/
if (Wcm.cm_magicwrap)
if (tty->Wcm->cm_magicwrap)
; /* "limbo" */
else if (Wcm.cm_autowrap) {
curX = 0;
curY++; /* Beware end of screen! */
else if (tty->Wcm->cm_autowrap) {
curX (tty) = 0;
curY (tty) ++; /* Beware end of screen! */
}
else
curX--;
curX (tty)--;
}
}
#endif
@ -123,20 +131,20 @@ addcol (n) {
* after we reach the last column; this takes us to a known state.
*/
void
cmcheckmagic ()
cmcheckmagic (struct tty_display_info *tty)
{
if (curX == FrameCols)
if (curX (tty) == FrameCols (tty))
{
if (!MagicWrap || curY >= FrameRows - 1)
if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
abort ();
if (termscript)
putc ('\r', termscript);
putchar ('\r');
if (termscript)
putc ('\n', termscript);
putchar ('\n');
curX = 0;
curY++;
if (tty->termscript)
putc ('\r', tty->termscript);
putc ('\r', tty->output);
if (tty->termscript)
putc ('\n', tty->termscript);
putc ('\n', tty->output);
curX (tty) = 0;
curY (tty)++;
}
}
@ -148,21 +156,21 @@ cmcheckmagic ()
*/
void
cmcostinit ()
cmcostinit (struct tty_display_info *tty)
{
char *p;
#define COST(x,e) (x ? (cost = 0, tputs (x, 1, e), cost) : BIG)
#define CMCOST(x,e) ((x == 0) ? BIG : (p = tgoto(x, 0, 0), COST(p ,e)))
Wcm.cc_up = COST (Wcm.cm_up, evalcost);
Wcm.cc_down = COST (Wcm.cm_down, evalcost);
Wcm.cc_left = COST (Wcm.cm_left, evalcost);
Wcm.cc_right = COST (Wcm.cm_right, evalcost);
Wcm.cc_home = COST (Wcm.cm_home, evalcost);
Wcm.cc_cr = COST (Wcm.cm_cr, evalcost);
Wcm.cc_ll = COST (Wcm.cm_ll, evalcost);
Wcm.cc_tab = Wcm.cm_tabwidth ? COST (Wcm.cm_tab, evalcost) : BIG;
tty->Wcm->cc_up = COST (tty->Wcm->cm_up, evalcost);
tty->Wcm->cc_down = COST (tty->Wcm->cm_down, evalcost);
tty->Wcm->cc_left = COST (tty->Wcm->cm_left, evalcost);
tty->Wcm->cc_right = COST (tty->Wcm->cm_right, evalcost);
tty->Wcm->cc_home = COST (tty->Wcm->cm_home, evalcost);
tty->Wcm->cc_cr = COST (tty->Wcm->cm_cr, evalcost);
tty->Wcm->cc_ll = COST (tty->Wcm->cm_ll, evalcost);
tty->Wcm->cc_tab = tty->Wcm->cm_tabwidth ? COST (tty->Wcm->cm_tab, evalcost) : BIG;
/*
* These last three are actually minimum costs. When (if) they are
@ -173,9 +181,9 @@ cmcostinit ()
* cursor motion seem to take straight numeric values. --ACT)
*/
Wcm.cc_abs = CMCOST (Wcm.cm_abs, evalcost);
Wcm.cc_habs = CMCOST (Wcm.cm_habs, evalcost);
Wcm.cc_vabs = CMCOST (Wcm.cm_vabs, evalcost);
tty->Wcm->cc_abs = CMCOST (tty->Wcm->cm_abs, evalcost);
tty->Wcm->cc_habs = CMCOST (tty->Wcm->cm_habs, evalcost);
tty->Wcm->cc_vabs = CMCOST (tty->Wcm->cm_vabs, evalcost);
#undef CMCOST
#undef COST
@ -188,8 +196,8 @@ cmcostinit ()
*/
static int
calccost (srcy, srcx, dsty, dstx, doit)
int srcy, srcx, dsty, dstx, doit;
calccost (struct tty_display_info *tty,
int srcy, int srcx, int dsty, int dstx, int doit)
{
register int deltay,
deltax,
@ -206,16 +214,16 @@ calccost (srcy, srcx, dsty, dstx, doit)
don't believe the cursor position: give up here
and force use of absolute positioning. */
if (curX == Wcm.cm_cols)
if (curX (tty) == tty->Wcm->cm_cols)
goto fail;
totalcost = 0;
if ((deltay = dsty - srcy) == 0)
goto x;
if (deltay < 0)
p = Wcm.cm_up, c = Wcm.cc_up, deltay = -deltay;
p = tty->Wcm->cm_up, c = tty->Wcm->cc_up, deltay = -deltay;
else
p = Wcm.cm_down, c = Wcm.cc_down;
p = tty->Wcm->cm_down, c = tty->Wcm->cc_down;
if (c == BIG) { /* caint get thar from here */
if (doit)
printf ("OOPS");
@ -224,16 +232,16 @@ calccost (srcy, srcx, dsty, dstx, doit)
totalcost = c * deltay;
if (doit)
while (--deltay >= 0)
tputs (p, 1, cmputc);
emacs_tputs (tty, p, 1, cmputc);
x:
if ((deltax = dstx - srcx) == 0)
goto done;
if (deltax < 0) {
p = Wcm.cm_left, c = Wcm.cc_left, deltax = -deltax;
p = tty->Wcm->cm_left, c = tty->Wcm->cc_left, deltax = -deltax;
goto dodelta; /* skip all the tab junk */
}
/* Tabs (the toughie) */
if (Wcm.cc_tab >= BIG || !Wcm.cm_usetabs)
if (tty->Wcm->cc_tab >= BIG || !tty->Wcm->cm_usetabs)
goto olddelta; /* forget it! */
/*
@ -244,12 +252,12 @@ calccost (srcy, srcx, dsty, dstx, doit)
* we will put into tabx (for ntabs) and tab2x (for n2tabs)).
*/
ntabs = (deltax + srcx % Wcm.cm_tabwidth) / Wcm.cm_tabwidth;
ntabs = (deltax + srcx % tty->Wcm->cm_tabwidth) / tty->Wcm->cm_tabwidth;
n2tabs = ntabs + 1;
tabx = (srcx / Wcm.cm_tabwidth + ntabs) * Wcm.cm_tabwidth;
tab2x = tabx + Wcm.cm_tabwidth;
tabx = (srcx / tty->Wcm->cm_tabwidth + ntabs) * tty->Wcm->cm_tabwidth;
tab2x = tabx + tty->Wcm->cm_tabwidth;
if (tab2x >= Wcm.cm_cols) /* too far (past edge) */
if (tab2x >= tty->Wcm->cm_cols) /* too far (past edge) */
n2tabs = 0;
/*
@ -257,12 +265,12 @@ calccost (srcy, srcx, dsty, dstx, doit)
* for using n2tabs, then pick the minimum.
*/
/* cost for ntabs + cost for right motion */
tabcost = ntabs ? ntabs * Wcm.cc_tab + (dstx - tabx) * Wcm.cc_right
/* cost for ntabs + cost for right motion */
tabcost = ntabs ? ntabs * tty->Wcm->cc_tab + (dstx - tabx) * tty->Wcm->cc_right
: BIG;
/* cost for n2tabs + cost for left motion */
c = n2tabs ? n2tabs * Wcm.cc_tab + (tab2x - dstx) * Wcm.cc_left
/* cost for n2tabs + cost for left motion */
c = n2tabs ? n2tabs * tty->Wcm->cc_tab + (tab2x - dstx) * tty->Wcm->cc_left
: BIG;
if (c < tabcost) /* then cheaper to overshoot & back up */
@ -275,11 +283,11 @@ calccost (srcy, srcx, dsty, dstx, doit)
* See if tabcost is less than just moving right
*/
if (tabcost < (deltax * Wcm.cc_right)) {
if (tabcost < (deltax * tty->Wcm->cc_right)) {
totalcost += tabcost; /* use the tabs */
if (doit)
while (--ntabs >= 0)
tputs (Wcm.cm_tab, 1, cmputc);
emacs_tputs (tty, tty->Wcm->cm_tab, 1, cmputc);
srcx = tabx;
}
@ -292,9 +300,9 @@ calccost (srcy, srcx, dsty, dstx, doit)
goto done;
olddelta:
if (deltax > 0)
p = Wcm.cm_right, c = Wcm.cc_right;
p = tty->Wcm->cm_right, c = tty->Wcm->cc_right;
else
p = Wcm.cm_left, c = Wcm.cc_left, deltax = -deltax;
p = tty->Wcm->cm_left, c = tty->Wcm->cc_left, deltax = -deltax;
dodelta:
if (c == BIG) { /* caint get thar from here */
@ -306,7 +314,7 @@ calccost (srcy, srcx, dsty, dstx, doit)
totalcost += c * deltax;
if (doit)
while (--deltax >= 0)
tputs (p, 1, cmputc);
emacs_tputs (tty, p, 1, cmputc);
done:
return totalcost;
}
@ -324,7 +332,8 @@ losecursor ()
#define USECR 3
void
cmgoto (row, col)
cmgoto (tty, row, col)
struct tty_display_info *tty;
int row, col;
{
int homecost,
@ -337,47 +346,47 @@ cmgoto (row, col)
*dcm;
/* First the degenerate case */
if (row == curY && col == curX) /* already there */
if (row == curY (tty) && col == curX (tty)) /* already there */
return;
if (curY >= 0 && curX >= 0)
if (curY (tty) >= 0 && curX (tty) >= 0)
{
/* We may have quick ways to go to the upper-left, bottom-left,
* start-of-line, or start-of-next-line. Or it might be best to
* start where we are. Examine the options, and pick the cheapest.
*/
relcost = calccost (curY, curX, row, col, 0);
relcost = calccost (tty, curY (tty), curX (tty), row, col, 0);
use = USEREL;
if ((homecost = Wcm.cc_home) < BIG)
homecost += calccost (0, 0, row, col, 0);
if ((homecost = tty->Wcm->cc_home) < BIG)
homecost += calccost (tty, 0, 0, row, col, 0);
if (homecost < relcost)
relcost = homecost, use = USEHOME;
if ((llcost = Wcm.cc_ll) < BIG)
llcost += calccost (Wcm.cm_rows - 1, 0, row, col, 0);
relcost = homecost, use = USEHOME;
if ((llcost = tty->Wcm->cc_ll) < BIG)
llcost += calccost (tty, tty->Wcm->cm_rows - 1, 0, row, col, 0);
if (llcost < relcost)
relcost = llcost, use = USELL;
if ((crcost = Wcm.cc_cr) < BIG) {
if (Wcm.cm_autolf)
if (curY + 1 >= Wcm.cm_rows)
crcost = BIG;
relcost = llcost, use = USELL;
if ((crcost = tty->Wcm->cc_cr) < BIG) {
if (tty->Wcm->cm_autolf)
if (curY (tty) + 1 >= tty->Wcm->cm_rows)
crcost = BIG;
else
crcost += calccost (curY + 1, 0, row, col, 0);
crcost += calccost (tty, curY (tty) + 1, 0, row, col, 0);
else
crcost += calccost (curY, 0, row, col, 0);
crcost += calccost (tty, curY (tty), 0, row, col, 0);
}
if (crcost < relcost)
relcost = crcost, use = USECR;
directcost = Wcm.cc_abs, dcm = Wcm.cm_abs;
if (row == curY && Wcm.cc_habs < BIG)
directcost = Wcm.cc_habs, dcm = Wcm.cm_habs;
else if (col == curX && Wcm.cc_vabs < BIG)
directcost = Wcm.cc_vabs, dcm = Wcm.cm_vabs;
directcost = tty->Wcm->cc_abs, dcm = tty->Wcm->cm_abs;
if (row == curY (tty) && tty->Wcm->cc_habs < BIG)
directcost = tty->Wcm->cc_habs, dcm = tty->Wcm->cm_habs;
else if (col == curX (tty) && tty->Wcm->cc_vabs < BIG)
directcost = tty->Wcm->cc_vabs, dcm = tty->Wcm->cm_vabs;
}
else
{
directcost = 0, relcost = 100000;
dcm = Wcm.cm_abs;
dcm = tty->Wcm->cm_abs;
}
/*
@ -388,13 +397,14 @@ cmgoto (row, col)
{
/* compute REAL direct cost */
cost = 0;
p = dcm == Wcm.cm_habs ? tgoto (dcm, row, col) :
tgoto (dcm, col, row);
tputs (p, 1, evalcost);
p = (dcm == tty->Wcm->cm_habs
? tgoto (dcm, row, col)
: tgoto (dcm, col, row));
emacs_tputs (tty, p, 1, evalcost);
if (cost <= relcost)
{ /* really is cheaper */
tputs (p, 1, cmputc);
curY = row, curX = col;
emacs_tputs (tty, p, 1, cmputc);
curY (tty) = row, curX (tty) = col;
return;
}
}
@ -402,25 +412,25 @@ cmgoto (row, col)
switch (use)
{
case USEHOME:
tputs (Wcm.cm_home, 1, cmputc);
curY = 0, curX = 0;
emacs_tputs (tty, tty->Wcm->cm_home, 1, cmputc);
curY (tty) = 0, curX (tty) = 0;
break;
case USELL:
tputs (Wcm.cm_ll, 1, cmputc);
curY = Wcm.cm_rows - 1, curX = 0;
emacs_tputs (tty, tty->Wcm->cm_ll, 1, cmputc);
curY (tty) = tty->Wcm->cm_rows - 1, curX (tty) = 0;
break;
case USECR:
tputs (Wcm.cm_cr, 1, cmputc);
if (Wcm.cm_autolf)
curY++;
curX = 0;
emacs_tputs (tty, tty->Wcm->cm_cr, 1, cmputc);
if (tty->Wcm->cm_autolf)
curY (tty)++;
curX (tty) = 0;
break;
}
(void) calccost (curY, curX, row, col, 1);
curY = row, curX = col;
(void) calccost (tty, curY (tty), curX (tty), row, col, 1);
curY (tty) = row, curX (tty) = col;
}
/* Clear out all terminal info.
@ -428,9 +438,9 @@ cmgoto (row, col)
*/
void
Wcm_clear ()
Wcm_clear (struct tty_display_info *tty)
{
bzero (&Wcm, sizeof Wcm);
bzero (tty->Wcm, sizeof (struct cm));
UP = 0;
BC = 0;
}
@ -443,21 +453,21 @@ Wcm_clear ()
*/
int
Wcm_init ()
Wcm_init (struct tty_display_info *tty)
{
#if 0
if (Wcm.cm_abs && !Wcm.cm_ds)
if (tty->Wcm->cm_abs && !tty->Wcm->cm_ds)
return 0;
#endif
if (Wcm.cm_abs)
if (tty->Wcm->cm_abs)
return 0;
/* Require up and left, and, if no absolute, down and right */
if (!Wcm.cm_up || !Wcm.cm_left)
if (!tty->Wcm->cm_up || !tty->Wcm->cm_left)
return - 1;
if (!Wcm.cm_abs && (!Wcm.cm_down || !Wcm.cm_right))
if (!tty->Wcm->cm_abs && (!tty->Wcm->cm_down || !tty->Wcm->cm_right))
return - 1;
/* Check that we know the size of the screen.... */
if (Wcm.cm_rows <= 0 || Wcm.cm_cols <= 0)
if (tty->Wcm->cm_rows <= 0 || tty->Wcm->cm_cols <= 0)
return - 2;
return 0;
}

116
src/cm.h
View file

@ -99,76 +99,78 @@ struct cm
int cc_vabs;
};
extern struct cm Wcm; /* Terminal capabilities */
extern char PC; /* Pad character */
/* Shorthand */
#ifndef NoCMShortHand
#define curY Wcm.cm_curY
#define curX Wcm.cm_curX
#define Up Wcm.cm_up
#define Down Wcm.cm_down
#define Left Wcm.cm_left
#define Right Wcm.cm_right
#define Tab Wcm.cm_tab
#define BackTab Wcm.cm_backtab
#define TabWidth Wcm.cm_tabwidth
#define CR Wcm.cm_cr
#define Home Wcm.cm_home
#define LastLine Wcm.cm_ll
#define AbsPosition Wcm.cm_abs
#define ColPosition Wcm.cm_habs
#define RowPosition Wcm.cm_vabs
#define MultiUp Wcm.cm_multiup
#define MultiDown Wcm.cm_multidown
#define MultiLeft Wcm.cm_multileft
#define MultiRight Wcm.cm_multiright
#define AutoWrap Wcm.cm_autowrap
#define MagicWrap Wcm.cm_magicwrap
#define UseTabs Wcm.cm_usetabs
#define FrameRows Wcm.cm_rows
#define FrameCols Wcm.cm_cols
#define curY(tty) (tty)->Wcm->cm_curY
#define curX(tty) (tty)->Wcm->cm_curX
#define Up(tty) (tty)->Wcm->cm_up
#define Down(tty) (tty)->Wcm->cm_down
#define Left(tty) (tty)->Wcm->cm_left
#define Right(tty) (tty)->Wcm->cm_right
#define Tab(tty) (tty)->Wcm->cm_tab
#define BackTab(tty) (tty)->Wcm->cm_backtab
#define TabWidth(tty) (tty)->Wcm->cm_tabwidth
#define CR(tty) (tty)->Wcm->cm_cr
#define Home(tty) (tty)->Wcm->cm_home
#define LastLine(tty) (tty)->Wcm->cm_ll
#define AbsPosition(tty) (tty)->Wcm->cm_abs
#define ColPosition(tty) (tty)->Wcm->cm_habs
#define RowPosition(tty) (tty)->Wcm->cm_vabs
#define MultiUp(tty) (tty)->Wcm->cm_multiup
#define MultiDown(tty) (tty)->Wcm->cm_multidown
#define MultiLeft(tty) (tty)->Wcm->cm_multileft
#define MultiRight(tty) (tty)->Wcm->cm_multiright
#define AutoWrap(tty) (tty)->Wcm->cm_autowrap
#define MagicWrap(tty) (tty)->Wcm->cm_magicwrap
#define UseTabs(tty) (tty)->Wcm->cm_usetabs
#define FrameRows(tty) (tty)->Wcm->cm_rows
#define FrameCols(tty) (tty)->Wcm->cm_cols
#define UpCost Wcm.cc_up
#define DownCost Wcm.cc_down
#define LeftCost Wcm.cc_left
#define RightCost Wcm.cc_right
#define HomeCost Wcm.cc_home
#define CRCost Wcm.cc_cr
#define LastLineCost Wcm.cc_ll
#define TabCost Wcm.cc_tab
#define BackTabCost Wcm.cc_backtab
#define AbsPositionCost Wcm.cc_abs
#define ColPositionCost Wcm.cc_habs
#define RowPositionCost Wcm.cc_vabs
#define MultiUpCost Wcm.cc_multiup
#define MultiDownCost Wcm.cc_multidown
#define MultiLeftCost Wcm.cc_multileft
#define MultiRightCost Wcm.cc_multiright
#define UpCost(tty) (tty)->Wcm->cc_up
#define DownCost(tty) (tty)->Wcm->cc_down
#define LeftCost(tty) (tty)->Wcm->cc_left
#define RightCost(tty) (tty)->Wcm->cc_right
#define HomeCost(tty) (tty)->Wcm->cc_home
#define CRCost(tty) (tty)->Wcm->cc_cr
#define LastLineCost(tty) (tty)->Wcm->cc_ll
#define TabCost(tty) (tty)->Wcm->cc_tab
#define BackTabCost(tty) (tty)->Wcm->cc_backtab
#define AbsPositionCost(tty) (tty)->Wcm->cc_abs
#define ColPositionCost(tty) (tty)->Wcm->cc_habs
#define RowPositionCost(tty) (tty)->Wcm->cc_vabs
#define MultiUpCost(tty) (tty)->Wcm->cc_multiup
#define MultiDownCost(tty) (tty)->Wcm->cc_multidown
#define MultiLeftCost(tty) (tty)->Wcm->cc_multileft
#define MultiRightCost(tty) (tty)->Wcm->cc_multiright
#endif
#define cmat(row,col) (curY = (row), curX = (col))
#define cmplus(n) \
{ \
if ((curX += (n)) >= FrameCols && !MagicWrap) \
{ \
if (Wcm.cm_losewrap) losecursor (); \
else if (AutoWrap) curX = 0, curY++; \
else curX--; \
} \
#define cmat(tty,row,col) (curY(tty) = (row), curX(tty) = (col))
#define cmplus(tty,n) \
{ \
if ((curX (tty) += (n)) >= FrameCols (tty) && !MagicWrap (tty)) \
{ \
if ((tty)->Wcm->cm_losewrap) losecursor (tty); \
else if (AutoWrap (tty)) curX (tty) = 0, curY (tty)++; \
else curX (tty)--; \
} \
}
#define losecursor() (curX = -1, curY = -1)
#define losecursor(tty) (curX(tty) = -1, curY(tty) = -1)
extern int cost;
extern int evalcost ();
extern void cmcheckmagic ();
extern int cmputc ();
extern void cmcostinit ();
extern void cmgoto ();
extern void Wcm_clear ();
extern int Wcm_init ();
#define emacs_tputs(tty, str, affcnt, putc) (current_tty = (tty), tputs (str, affcnt, putc))
extern struct tty_display_info *current_tty;
extern void cmcheckmagic P_ ((struct tty_display_info *));
extern int cmputc P_ ((int));
extern void cmcostinit P_ ((struct tty_display_info *));
extern void cmgoto P_ ((struct tty_display_info *, int, int));
extern void Wcm_clear P_ ((struct tty_display_info *));
extern int Wcm_init P_ ((struct tty_display_info *));
/* arch-tag: acc1535a-7136-49d6-b22d-9bc85702251b
(do not change this comment) */

62
src/coding.c
View file

@ -351,6 +351,8 @@ encode_coding_XXX (coding, source, destination, src_bytes, dst_bytes)
#include "coding.h"
#include "window.h"
#include "intervals.h"
#include "frame.h"
#include "termhooks.h"
#else /* not emacs */
@ -436,16 +438,10 @@ int inhibit_iso_escape_detection;
/* Flag to make buffer-file-coding-system inherit from process-coding. */
int inherit_process_coding_system;
/* Coding system to be used to encode text for terminal display. */
struct coding_system terminal_coding;
/* Coding system to be used to encode text for terminal display when
terminal coding system is nil. */
struct coding_system safe_terminal_coding;
/* Coding system of what is sent from terminal keyboard. */
struct coding_system keyboard_coding;
/* Default coding system to be used to write a file. */
struct coding_system default_buffer_file_coding;
@ -7368,21 +7364,23 @@ Return the corresponding character code in Big5. */)
}
DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal,
Sset_terminal_coding_system_internal, 1, 1, 0,
Sset_terminal_coding_system_internal, 1, 2, 0,
doc: /* Internal use only. */)
(coding_system)
(coding_system, terminal)
Lisp_Object coding_system;
Lisp_Object terminal;
{
struct coding_system *terminal_coding = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1));
CHECK_SYMBOL (coding_system);
setup_coding_system (Fcheck_coding_system (coding_system), &terminal_coding);
setup_coding_system (Fcheck_coding_system (coding_system), terminal_coding);
/* We had better not send unsafe characters to terminal. */
terminal_coding.mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR;
terminal_coding->mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR;
/* Character composition should be disabled. */
terminal_coding.composing = COMPOSITION_DISABLED;
terminal_coding->composing = COMPOSITION_DISABLED;
/* Error notification should be suppressed. */
terminal_coding.suppress_error = 1;
terminal_coding.src_multibyte = 1;
terminal_coding.dst_multibyte = 0;
terminal_coding->suppress_error = 1;
terminal_coding->src_multibyte = 1;
terminal_coding->dst_multibyte = 0;
return Qnil;
}
@ -7405,32 +7403,42 @@ DEFUN ("set-safe-terminal-coding-system-internal", Fset_safe_terminal_coding_sys
}
DEFUN ("terminal-coding-system", Fterminal_coding_system,
Sterminal_coding_system, 0, 0, 0,
doc: /* Return coding system specified for terminal output. */)
()
Sterminal_coding_system, 0, 1, 0,
doc: /* Return coding system specified for terminal output on the given terminal.
TERMINAL may be a terminal id, a frame, or nil for the selected
frame's terminal device. */)
(terminal)
Lisp_Object terminal;
{
return terminal_coding.symbol;
return TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1))->symbol;
}
DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal,
Sset_keyboard_coding_system_internal, 1, 1, 0,
Sset_keyboard_coding_system_internal, 1, 2, 0,
doc: /* Internal use only. */)
(coding_system)
(coding_system, terminal)
Lisp_Object coding_system;
Lisp_Object terminal;
{
struct terminal *t = get_terminal (terminal, 1);
CHECK_SYMBOL (coding_system);
setup_coding_system (Fcheck_coding_system (coding_system), &keyboard_coding);
setup_coding_system (Fcheck_coding_system (coding_system),
TERMINAL_KEYBOARD_CODING (t));
/* Character composition should be disabled. */
keyboard_coding.composing = COMPOSITION_DISABLED;
TERMINAL_KEYBOARD_CODING (t)->composing = COMPOSITION_DISABLED;
return Qnil;
}
DEFUN ("keyboard-coding-system", Fkeyboard_coding_system,
Skeyboard_coding_system, 0, 0, 0,
doc: /* Return coding system specified for decoding keyboard input. */)
()
Skeyboard_coding_system, 0, 1, 0,
doc: /* Return coding system for decoding keyboard input on TERMINAL.
TERMINAL may be a terminal id, a frame, or nil for the selected
frame's terminal device. */)
(terminal)
Lisp_Object terminal;
{
return keyboard_coding.symbol;
return TERMINAL_KEYBOARD_CODING (get_terminal (terminal, 1))->symbol;
}
@ -7695,8 +7703,6 @@ init_coding_once ()
iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
setup_coding_system (Qnil, &keyboard_coding);
setup_coding_system (Qnil, &terminal_coding);
setup_coding_system (Qnil, &safe_terminal_coding);
setup_coding_system (Qnil, &default_buffer_file_coding);

10
src/coding.h
View file

@ -696,20 +696,10 @@ extern Lisp_Object Vlocale_coding_system;
the subprocess output. */
extern int inherit_process_coding_system;
/* Coding-system to be used for encoding terminal output. This
structure contains information of a coding-system specified by the
function `set-terminal-coding-system'. */
extern struct coding_system terminal_coding;
/* Coding system to be used to encode text for terminal display when
terminal coding system is nil. */
extern struct coding_system safe_terminal_coding;
/* Coding-system of what is sent from terminal keyboard. This
structure contains information of a coding-system specified by the
function `set-keyboard-coding-system'. */
extern struct coding_system keyboard_coding;
/* Default coding system to be used to write a file. */
extern struct coding_system default_buffer_file_coding;

8
src/config.in
View file

@ -929,11 +929,19 @@ Boston, MA 02110-1301, USA. */
#define HAVE_MOUSE
#endif
/* Multi-tty support relies on MULTI_KBOARD. It seems safe to turn it
on unconditionally. */
#ifndef MULTI_KBOARD
#define MULTI_KBOARD
#endif
/* If we're using the Carbon API on Mac OS X, define a few more
variables as well. */
#ifdef HAVE_CARBON
#define HAVE_WINDOW_SYSTEM
#define HAVE_MOUSE
/* XXX The MULTI_KBOARD support does not work yet on this platform. */
#undef MULTI_KBOARD
#endif
/* Define USER_FULL_NAME to return a string

67
src/data.c
View file

@ -30,6 +30,7 @@ Boston, MA 02110-1301, USA. */
#include "keyboard.h"
#include "frame.h"
#include "syssignal.h"
#include "termhooks.h" /* For FRAME_KBOARD reference in y-or-n-p. */
#ifdef STDC_HEADERS
#include <float.h>
@ -873,7 +874,18 @@ do_symval_forwarding (valcontents)
case Lisp_Misc_Kboard_Objfwd:
offset = XKBOARD_OBJFWD (valcontents)->offset;
return *(Lisp_Object *)(offset + (char *)current_kboard);
/* We used to simply use current_kboard here, but from Lisp
code, it's value is often unexpected. It seems nicer to
allow constructions like this to work as intuitively expected:
(with-selected-frame frame
(define-key local-function-map "\eOP" [f1]))
On the other hand, this affects the semantics of
last-command and real-last-command, and people may rely on
that. I took a quick look at the Lisp codebase, and I
don't think anything will break. --lorentey */
return *(Lisp_Object *)(offset + (char *)FRAME_KBOARD (SELECTED_FRAME ()));
}
return valcontents;
}
@ -961,7 +973,7 @@ store_symval_forwarding (symbol, valcontents, newval, buf)
case Lisp_Misc_Kboard_Objfwd:
{
char *base = (char *) current_kboard;
char *base = (char *) FRAME_KBOARD (SELECTED_FRAME ());
char *p = base + XKBOARD_OBJFWD (valcontents)->offset;
*(Lisp_Object *) p = newval;
}
@ -1107,7 +1119,7 @@ find_symbol_value (symbol)
case Lisp_Misc_Kboard_Objfwd:
return *(Lisp_Object *)(XKBOARD_OBJFWD (valcontents)->offset
+ (char *)current_kboard);
+ (char *)FRAME_KBOARD (SELECTED_FRAME ()));
}
}
@ -1868,6 +1880,51 @@ If the current binding is global (the default), the value is nil. */)
return Qnil;
}
/* This code is disabled now that we use the selected frame to return
keyboard-local-values. */
#if 0
extern struct terminal *get_terminal P_ ((Lisp_Object display, int));
DEFUN ("terminal-local-value", Fterminal_local_value, Sterminal_local_value, 2, 2, 0,
doc: /* Return the terminal-local value of SYMBOL on TERMINAL.
If SYMBOL is not a terminal-local variable, then return its normal
value, like `symbol-value'.
TERMINAL may be a terminal id, a frame, or nil (meaning the
selected frame's terminal device). */)
(symbol, terminal)
Lisp_Object symbol;
Lisp_Object terminal;
{
Lisp_Object result;
struct terminal *t = get_terminal (terminal, 1);
push_kboard (t->kboard);
result = Fsymbol_value (symbol);
pop_kboard ();
return result;
}
DEFUN ("set-terminal-local-value", Fset_terminal_local_value, Sset_terminal_local_value, 3, 3, 0,
doc: /* Set the terminal-local binding of SYMBOL on TERMINAL to VALUE.
If VARIABLE is not a terminal-local variable, then set its normal
binding, like `set'.
TERMINAL may be a terminal id, a frame, or nil (meaning the
selected frame's terminal device). */)
(symbol, terminal, value)
Lisp_Object symbol;
Lisp_Object terminal;
Lisp_Object value;
{
Lisp_Object result;
struct terminal *t = get_terminal (terminal, 1);
push_kboard (d->kboard);
result = Fset (symbol, value);
pop_kboard ();
return result;
}
#endif
/* Find the function at the end of a chain of symbol function indirections. */
@ -3327,6 +3384,10 @@ syms_of_data ()
defsubr (&Slocal_variable_p);
defsubr (&Slocal_variable_if_set_p);
defsubr (&Svariable_binding_locus);
#if 0 /* XXX Remove this. --lorentey */
defsubr (&Sterminal_local_value);
defsubr (&Sset_terminal_local_value);
#endif
defsubr (&Saref);
defsubr (&Saset);
defsubr (&Snumber_to_string);

92
src/dispextern.h
View file

@ -1029,13 +1029,8 @@ extern int fonts_changed_p;
extern struct glyph space_glyph;
/* Frame being updated by update_window/update_frame. */
extern struct frame *updating_frame;
/* Window being updated by update_window. This is non-null as long as
update_window has not finished, and null otherwise. It's role is
analogous to updating_frame. */
update_window has not finished, and null otherwise. */
extern struct window *updated_window;
@ -1355,7 +1350,7 @@ struct glyph_string
DESCENT = FONT->descent
HEIGHT = FONT_HEIGHT (FONT)
F_DESCENT = (FRAME_FONT (F)->descent
- F->output_data.x->baseline_offset)
- F->terminal->output_data.x->baseline_offset)
F_HEIGHT = FRAME_LINE_HEIGHT (F)
*/
@ -2184,16 +2179,16 @@ struct it
/* Call produce_glyphs or produce_glyphs_hook, if set. Shortcut to
avoid the function call overhead. */
#define PRODUCE_GLYPHS(IT) \
do { \
extern int inhibit_free_realized_faces; \
if (rif != NULL) \
rif->produce_glyphs ((IT)); \
else \
produce_glyphs ((IT)); \
if ((IT)->glyph_row != NULL) \
inhibit_free_realized_faces = 1; \
} while (0)
#define PRODUCE_GLYPHS(IT) \
do { \
extern int inhibit_free_realized_faces; \
if (FRAME_RIF ((IT)->f) != NULL) \
FRAME_RIF ((IT)->f)->produce_glyphs ((IT)); \
else \
produce_glyphs ((IT)); \
if ((IT)->glyph_row != NULL) \
inhibit_free_realized_faces = 1; \
} while (0)
/* Bit-flags indicating what operation move_it_to should perform. */
@ -2367,10 +2362,6 @@ struct redisplay_interface
#endif /* HAVE_WINDOW_SYSTEM */
};
/* The current interface for window-based redisplay. */
extern struct redisplay_interface *rif;
/***********************************************************************
Images
@ -2674,8 +2665,6 @@ void init_iterator_to_row_start P_ ((struct it *, struct window *,
struct glyph_row *));
int get_next_display_element P_ ((struct it *));
void set_iterator_to_next P_ ((struct it *, int));
void produce_glyphs P_ ((struct it *));
void produce_special_glyphs P_ ((struct it *, enum display_element_type));
void start_display P_ ((struct it *, struct window *, struct text_pos));
void move_it_to P_ ((struct it *, int, int, int, int, int));
void move_it_vertically P_ ((struct it *, int));
@ -2822,11 +2811,11 @@ int image_ascent P_ ((struct image *, struct face *, struct glyph_slice *));
/* Defined in sysdep.c */
void get_frame_size P_ ((int *, int *));
void get_tty_size P_ ((int, int *, int *));
void request_sigio P_ ((void));
void unrequest_sigio P_ ((void));
int tabs_safe_p P_ ((void));
void init_baud_rate P_ ((void));
int tabs_safe_p P_ ((int));
void init_baud_rate P_ ((int));
void init_sigio P_ ((int));
/* Defined in xfaces.c */
@ -2965,8 +2954,6 @@ void clear_glyph_row P_ ((struct glyph_row *));
void prepare_desired_row P_ ((struct glyph_row *));
int line_hash_code P_ ((struct glyph_row *));
void set_window_update_flags P_ ((struct window *, int));
void write_glyphs P_ ((struct glyph *, int));
void insert_glyphs P_ ((struct glyph *, int));
void redraw_frame P_ ((struct frame *));
void redraw_garbaged_frames P_ ((void));
int scroll_cost P_ ((struct frame *, int, int, int));
@ -2983,31 +2970,44 @@ void syms_of_display P_ ((void));
extern Lisp_Object Qredisplay_dont_pause;
GLYPH spec_glyph_lookup_face P_ ((struct window *, GLYPH));
/* Defined in term.c */
/* Defined in terminal.c */
extern void ring_bell P_ ((void));
extern void set_terminal_modes P_ ((void));
extern void reset_terminal_modes P_ ((void));
extern void ring_bell P_ ((struct frame *));
extern void update_begin P_ ((struct frame *));
extern void update_end P_ ((struct frame *));
extern void set_terminal_window P_ ((int));
extern void set_scroll_region P_ ((int, int));
extern void turn_off_insert P_ ((void));
extern void turn_off_highlight P_ ((void));
extern void background_highlight P_ ((void));
extern void clear_frame P_ ((void));
extern void clear_end_of_line P_ ((int));
extern void clear_end_of_line_raw P_ ((int));
extern void delete_glyphs P_ ((int));
extern void ins_del_lines P_ ((int, int));
extern void set_terminal_window P_ ((struct frame *, int));
extern void cursor_to P_ ((struct frame *, int, int));
extern void raw_cursor_to P_ ((struct frame *, int, int));
extern void clear_to_end P_ ((struct frame *));
extern void clear_frame P_ ((struct frame *));
extern void clear_end_of_line P_ ((struct frame *, int));
extern void write_glyphs P_ ((struct frame *, struct glyph *, int));
extern void insert_glyphs P_ ((struct frame *, struct glyph *, int));
extern void delete_glyphs P_ ((struct frame *, int));
extern void ins_del_lines P_ ((struct frame *, int, int));
extern struct terminal *init_initial_terminal P_ ((void));
/* Defined in term.c */
extern void tty_set_terminal_modes P_ ((struct terminal *));
extern void tty_reset_terminal_modes P_ ((struct terminal *));
extern void tty_turn_off_insert P_ ((struct tty_display_info *));
extern void tty_turn_off_highlight P_ ((struct tty_display_info *));
extern int string_cost P_ ((char *));
extern int per_line_cost P_ ((char *));
extern void calculate_costs P_ ((struct frame *));
extern void produce_glyphs P_ ((struct it *));
extern void produce_special_glyphs P_ ((struct it *, enum display_element_type));
extern int tty_capable_p P_ ((struct tty_display_info *, unsigned, unsigned long, unsigned long));
extern void set_tty_color_mode P_ ((struct frame *, Lisp_Object));
extern void tty_setup_colors P_ ((int));
extern void term_init P_ ((char *));
void cursor_to P_ ((int, int));
extern int tty_capable_p P_ ((struct frame *, unsigned, unsigned long, unsigned long));
extern struct terminal *get_tty_terminal P_ ((Lisp_Object, int));
extern struct terminal *get_named_tty P_ ((char *));
EXFUN (Ftty_type, 1);
extern void create_tty_output P_ ((struct frame *));
extern struct terminal *init_tty P_ ((char *, char *, int));
/* Defined in scroll.c */

387
src/dispnew.c
View file

@ -32,7 +32,6 @@ Boston, MA 02110-1301, USA. */
#include "lisp.h"
#include "termchar.h"
#include "termopts.h"
#include "termhooks.h"
/* cm.h must come after dispextern.h on Windows. */
#include "dispextern.h"
#include "cm.h"
@ -40,6 +39,7 @@ Boston, MA 02110-1301, USA. */
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
#include "termhooks.h"
#include "window.h"
#include "commands.h"
#include "disptab.h"
@ -238,9 +238,9 @@ int inverse_video;
EMACS_INT baud_rate;
/* Either nil or a symbol naming the window system under which Emacs
is running. */
creates the first frame. */
Lisp_Object Vwindow_system;
Lisp_Object Vinitial_window_system;
/* Version number of X windows: 10, 11 or nil. */
@ -282,14 +282,6 @@ Lisp_Object selected_frame;
struct frame *last_nonminibuf_frame;
/* Stdio stream being used for copy of all output. */
FILE *termscript;
/* Structure for info on cursor positioning. */
struct cm Wcm;
/* 1 means SIGWINCH happened when not safe. */
int delayed_size_change;
@ -328,11 +320,6 @@ int glyph_pool_count;
static struct frame *frame_matrix_frame;
/* Current interface for window-based redisplay. Set from init_xterm.
A null value means we are not using window-based redisplay. */
struct redisplay_interface *rif;
/* Non-zero means that fonts have been loaded since the last glyph
matrix adjustments. Redisplay must stop, and glyph matrices must
be adjusted when this flag becomes non-zero during display. The
@ -1423,7 +1410,7 @@ line_hash_code (row)
{
int c = glyph->u.ch;
int face_id = glyph->face_id;
if (must_write_spaces)
if (FRAME_MUST_WRITE_SPACES (SELECTED_FRAME ())) /* XXX Is SELECTED_FRAME OK here? */
c -= SPACEGLYPH;
hash = (((hash << 4) + (hash >> 24)) & 0x0fffffff) + c;
hash = (((hash << 4) + (hash >> 24)) & 0x0fffffff) + face_id;
@ -1455,7 +1442,7 @@ line_draw_cost (matrix, vpos)
int glyph_table_len = GLYPH_TABLE_LENGTH;
/* Ignore trailing and leading spaces if we can. */
if (!must_write_spaces)
if (!FRAME_MUST_WRITE_SPACES (SELECTED_FRAME ())) /* XXX Is SELECTED_FRAME OK here? */
{
/* Skip from the end over trailing spaces. */
while (end > beg && CHAR_GLYPH_SPACE_P (*(end - 1)))
@ -1671,8 +1658,10 @@ realloc_glyph_pool (pool, matrix_dim)
#if GLYPH_DEBUG
/* Flush standard output. This is sometimes useful to call from
the debugger. */
/* Flush standard output. This is sometimes useful to call from the debugger.
XXX Maybe this should be changed to flush the current terminal instead of
stdout.
*/
void
flush_stdout ()
@ -3393,12 +3382,15 @@ DEFUN ("redraw-frame", Fredraw_frame, Sredraw_frame, 1, 1, 0,
return Qnil;
update_begin (f);
#ifdef MSDOS
if (FRAME_MSDOS_P (f))
set_terminal_modes ();
clear_frame ();
set_terminal_modes (FRAME_TERMINAL (f));
#endif
clear_frame (f);
clear_current_matrices (f);
update_end (f);
fflush (stdout);
if (FRAME_TERMCAP_P (f))
fflush (FRAME_TTY (f)->output);
windows_or_buffers_changed++;
/* Mark all windows as inaccurate, so that every window will have
its redisplay done. */
@ -3539,7 +3531,7 @@ direct_output_for_insert (g)
/* If we can't insert glyphs, we can use this method only
at the end of a line. */
if (!char_ins_del_ok)
if (!FRAME_CHAR_INS_DEL_OK (f))
if (PT != ZV && FETCH_BYTE (PT_BYTE) != '\n')
return 0;
@ -3689,24 +3681,24 @@ direct_output_for_insert (g)
updated_row = glyph_row;
updated_area = TEXT_AREA;
update_begin (f);
if (rif)
if (FRAME_RIF (f))
{
rif->update_window_begin_hook (w);
FRAME_RIF (f)->update_window_begin_hook (w);
if (glyphs == end - n
/* In front of a space added by append_space. */
|| (glyphs == end - n - 1
&& (end - n)->charpos <= 0))
rif->write_glyphs (glyphs, n);
FRAME_RIF (f)->write_glyphs (glyphs, n);
else
rif->insert_glyphs (glyphs, n);
FRAME_RIF (f)->insert_glyphs (glyphs, n);
}
else
{
if (glyphs == end - n)
write_glyphs (glyphs, n);
write_glyphs (f, glyphs, n);
else
insert_glyphs (glyphs, n);
insert_glyphs (f, glyphs, n);
}
w->cursor.hpos += n;
@ -3719,8 +3711,8 @@ direct_output_for_insert (g)
a frame matrix is used, cursor_to expects frame coordinates,
and the X and Y parameters are not used. */
if (window_redisplay_p)
rif->cursor_to (w->cursor.vpos, w->cursor.hpos,
w->cursor.y, w->cursor.x);
FRAME_RIF (f)->cursor_to (w->cursor.vpos, w->cursor.hpos,
w->cursor.y, w->cursor.x);
else
{
int x, y;
@ -3729,18 +3721,19 @@ direct_output_for_insert (g)
? XFASTINT (w->left_margin_cols)
: 0));
y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos);
cursor_to (y, x);
cursor_to (f, y, x);
}
#ifdef HAVE_WINDOW_SYSTEM
update_window_fringes (w, 0);
#endif
if (rif)
rif->update_window_end_hook (w, 1, 0);
if (FRAME_RIF (f))
FRAME_RIF (f)->update_window_end_hook (w, 1, 0);
update_end (f);
updated_row = NULL;
fflush (stdout);
if (FRAME_TERMCAP_P (f))
fflush (FRAME_TTY (f)->output);
TRACE ((stderr, "direct output for insert\n"));
mark_window_display_accurate (it.window, 1);
@ -3818,8 +3811,8 @@ direct_output_forward_char (n)
&& w->cursor.hpos < w->desired_matrix->matrix_w);
if (FRAME_WINDOW_P (f))
rif->cursor_to (w->cursor.vpos, w->cursor.hpos,
w->cursor.y, w->cursor.x);
FRAME_RIF (f)->cursor_to (w->cursor.vpos, w->cursor.hpos,
w->cursor.y, w->cursor.x);
else
{
int x, y;
@ -3828,10 +3821,11 @@ direct_output_forward_char (n)
? XFASTINT (w->left_margin_cols)
: 0));
y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos);
cursor_to (y, x);
cursor_to (f, y, x);
}
fflush (stdout);
if (FRAME_TERMCAP_P (f))
fflush (FRAME_TTY (f)->output);
redisplay_performed_directly_p = 1;
return 1;
}
@ -3930,14 +3924,14 @@ update_frame (f, force_p, inhibit_hairy_id_p)
update_end (f);
/* This flush is a performance bottleneck under X,
and it doesn't seem to be necessary anyway (in general).
and it doesn't seem to be necessary anyway (in general).
It is necessary when resizing the window with the mouse, or
at least the fringes are not redrawn in a timely manner. ++kfs */
at least the fringes are not redrawn in a timely manner. ++kfs */
if (f->force_flush_display_p)
{
rif->flush_display (f);
f->force_flush_display_p = 0;
}
{
FRAME_RIF (f)->flush_display (f);
f->force_flush_display_p = 0;
}
}
else
{
@ -3953,9 +3947,12 @@ update_frame (f, force_p, inhibit_hairy_id_p)
paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p);
update_end (f);
if (termscript)
fflush (termscript);
fflush (stdout);
if (FRAME_TERMCAP_P (f))
{
if (FRAME_TTY (f)->termscript)
fflush (FRAME_TTY (f)->termscript);
fflush (FRAME_TTY (f)->output);
}
/* Check window matrices for lost pointers. */
#if GLYPH_DEBUG
@ -4060,7 +4057,8 @@ redraw_overlapped_rows (w, yb)
int yb;
{
int i;
struct frame *f = XFRAME (WINDOW_FRAME (w));
/* If rows overlapping others have been changed, the rows being
overlapped have to be redrawn. This won't draw lines that have
already been drawn in update_window_line because overlapped_p in
@ -4083,10 +4081,12 @@ redraw_overlapped_rows (w, yb)
{
updated_row = row;
updated_area = area;
rif->cursor_to (i, 0, row->y, area == TEXT_AREA ? row->x : 0);
FRAME_RIF (f)->cursor_to (i, 0, row->y,
area == TEXT_AREA ? row->x : 0);
if (row->used[area])
rif->write_glyphs (row->glyphs[area], row->used[area]);
rif->clear_end_of_line (-1);
FRAME_RIF (f)->write_glyphs (row->glyphs[area],
row->used[area]);
FRAME_RIF (f)->clear_end_of_line (-1);
}
row->overlapped_p = 0;
@ -4108,7 +4108,8 @@ redraw_overlapping_rows (w, yb)
{
int i, bottom_y;
struct glyph_row *row;
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
for (i = 0; i < w->current_matrix->nrows; ++i)
{
row = w->current_matrix->rows + i;
@ -4199,10 +4200,10 @@ update_window (w, force_p)
#endif
extern int input_pending;
extern Lisp_Object do_mouse_tracking;
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
#if GLYPH_DEBUG
/* Check that W's frame doesn't have glyph matrices. */
xassert (FRAME_WINDOW_P (XFRAME (WINDOW_FRAME (w))));
xassert (updating_frame != NULL);
#endif
/* Check pending input the first time so that we can quickly return. */
@ -4387,6 +4388,7 @@ update_marginal_area (w, area, vpos)
int area, vpos;
{
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
/* Let functions in xterm.c know what area subsequent X positions
will be relative to. */
@ -4412,6 +4414,7 @@ update_text_area (w, vpos)
{
struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
int changed_p = 0;
/* Let functions in xterm.c know what area subsequent X positions
@ -4647,6 +4650,7 @@ update_window_line (w, vpos, mouse_face_overwritten_p)
{
struct glyph_row *current_row = MATRIX_ROW (w->current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (w->desired_matrix, vpos);
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
int changed_p = 0;
/* Set the row being updated. This is important to let xterm.c
@ -4715,6 +4719,7 @@ set_window_cursor_after_update (w)
struct window *w;
{
struct frame *f = XFRAME (w->frame);
struct redisplay_interface *rif = FRAME_RIF (f);
int cx, cy, vpos, hpos;
/* Not intended for frame matrix updates. */
@ -4938,6 +4943,7 @@ scrolling_window (w, header_line_p)
int i, j, first_old, first_new, last_old, last_new;
int nruns, nbytes, n, run_idx;
struct row_entry *entry;
struct redisplay_interface *rif = FRAME_RIF (XFRAME (WINDOW_FRAME (w)));
/* Skip over rows equal at the start. */
for (i = header_line_p ? 1 : 0; i < current_matrix->nrows - 1; ++i)
@ -5262,7 +5268,7 @@ update_frame_1 (f, force_p, inhibit_id_p)
#endif
/* If we cannot insert/delete lines, it's no use trying it. */
if (!line_ins_del_ok)
if (!FRAME_LINE_INS_DEL_OK (f))
inhibit_id_p = 1;
/* See if any of the desired lines are enabled; don't compute for
@ -5290,18 +5296,18 @@ update_frame_1 (f, force_p, inhibit_id_p)
Also flush out if likely to have more than 1k buffered
otherwise. I'm told that some telnet connections get
really screwed by more than 1k output at once. */
int outq = PENDING_OUTPUT_COUNT (stdout);
int outq = PENDING_OUTPUT_COUNT (FRAME_TTY (f)->output);
if (outq > 900
|| (outq > 20 && ((i - 1) % preempt_count == 0)))
{
fflush (stdout);
fflush (FRAME_TTY (f)->output);
if (preempt_count == 1)
{
#ifdef EMACS_OUTQSIZE
if (EMACS_OUTQSIZE (0, &outq) < 0)
/* Probably not a tty. Ignore the error and reset
the outq count. */
outq = PENDING_OUTPUT_COUNT (stdout);
outq = PENDING_OUTPUT_COUNT (FRAME_TTY (f->output));
#endif
outq *= 10;
if (baud_rate <= outq && baud_rate > 0)
@ -5404,7 +5410,7 @@ update_frame_1 (f, force_p, inhibit_id_p)
}
}
cursor_to (row, col);
cursor_to (f, row, col);
}
else
{
@ -5426,7 +5432,7 @@ update_frame_1 (f, force_p, inhibit_id_p)
x += XFASTINT (w->left_margin_cols);
/* x = max (min (x, FRAME_TOTAL_COLS (f) - 1), 0); */
cursor_to (y, x);
cursor_to (f, y, x);
}
}
}
@ -5495,21 +5501,23 @@ scrolling (frame)
}
/* If changed lines are few, don't allow preemption, don't scroll. */
if ((!scroll_region_ok && changed_lines < baud_rate / 2400)
if ((!FRAME_SCROLL_REGION_OK (frame)
&& changed_lines < baud_rate / 2400)
|| unchanged_at_bottom == FRAME_LINES (frame))
return 1;
window_size = (FRAME_LINES (frame) - unchanged_at_top
- unchanged_at_bottom);
if (scroll_region_ok)
if (FRAME_SCROLL_REGION_OK (frame))
free_at_end_vpos -= unchanged_at_bottom;
else if (memory_below_frame)
else if (FRAME_MEMORY_BELOW_FRAME (frame))
free_at_end_vpos = -1;
/* If large window, fast terminal and few lines in common between
current frame and desired frame, don't bother with i/d calc. */
if (!scroll_region_ok && window_size >= 18 && baud_rate > 2400
if (!FRAME_SCROLL_REGION_OK (frame)
&& window_size >= 18 && baud_rate > 2400
&& (window_size >=
10 * scrolling_max_lines_saved (unchanged_at_top,
FRAME_LINES (frame) - unchanged_at_bottom,
@ -5589,7 +5597,7 @@ update_frame_line (f, vpos)
struct glyph_row *current_row = MATRIX_ROW (current_matrix, vpos);
struct glyph_row *desired_row = MATRIX_ROW (desired_matrix, vpos);
int must_write_whole_line_p;
int write_spaces_p = must_write_spaces;
int write_spaces_p = FRAME_MUST_WRITE_SPACES (f);
int colored_spaces_p = (FACE_FROM_ID (f, DEFAULT_FACE_ID)->background
!= FACE_TTY_DEFAULT_BG_COLOR);
@ -5640,8 +5648,8 @@ update_frame_line (f, vpos)
/* Write the contents of the desired line. */
if (nlen)
{
cursor_to (vpos, 0);
write_glyphs (nbody, nlen);
cursor_to (f, vpos, 0);
write_glyphs (f, nbody, nlen);
}
/* Don't call clear_end_of_line if we already wrote the whole
@ -5649,13 +5657,13 @@ update_frame_line (f, vpos)
case but in the line below. */
if (nlen < FRAME_TOTAL_COLS (f))
{
cursor_to (vpos, nlen);
clear_end_of_line (FRAME_TOTAL_COLS (f));
cursor_to (f, vpos, nlen);
clear_end_of_line (f, FRAME_TOTAL_COLS (f));
}
else
/* Make sure we are in the right row, otherwise cursor movement
with cmgoto might use `ch' in the wrong row. */
cursor_to (vpos, 0);
cursor_to (f, vpos, 0);
make_current (desired_matrix, current_matrix, vpos);
return;
@ -5668,7 +5676,7 @@ update_frame_line (f, vpos)
nlen--;
/* If there's no i/d char, quickly do the best we can without it. */
if (!char_ins_del_ok)
if (!FRAME_CHAR_INS_DEL_OK (f))
{
int i, j;
@ -5687,8 +5695,8 @@ update_frame_line (f, vpos)
++j;
/* Output this run of non-matching chars. */
cursor_to (vpos, i);
write_glyphs (nbody + i, j - i);
cursor_to (f, vpos, i);
write_glyphs (f, nbody + i, j - i);
i = j - 1;
/* Now find the next non-match. */
@ -5698,8 +5706,8 @@ update_frame_line (f, vpos)
/* Clear the rest of the line, or the non-clear part of it. */
if (olen > nlen)
{
cursor_to (vpos, nlen);
clear_end_of_line (olen);
cursor_to (f, vpos, nlen);
clear_end_of_line (f, olen);
}
/* Make current row = desired row. */
@ -5721,8 +5729,8 @@ update_frame_line (f, vpos)
if (nlen > nsp)
{
cursor_to (vpos, nsp);
write_glyphs (nbody + nsp, nlen - nsp);
cursor_to (f, vpos, nsp);
write_glyphs (f, nbody + nsp, nlen - nsp);
}
/* Exchange contents between current_frame and new_frame. */
@ -5771,7 +5779,8 @@ update_frame_line (f, vpos)
tem = (nlen - nsp) - (olen - osp);
if (endmatch && tem
&& (!char_ins_del_ok || endmatch <= char_ins_del_cost (f)[tem]))
&& (!FRAME_CHAR_INS_DEL_OK (f)
|| endmatch <= char_ins_del_cost (f)[tem]))
endmatch = 0;
/* nsp - osp is the distance to insert or delete.
@ -5780,7 +5789,7 @@ update_frame_line (f, vpos)
Is it worth it? */
if (nsp != osp
&& (!char_ins_del_ok
&& (!FRAME_CHAR_INS_DEL_OK (f)
|| begmatch + endmatch <= char_ins_del_cost (f)[nsp - osp]))
{
begmatch = 0;
@ -5793,8 +5802,8 @@ update_frame_line (f, vpos)
if (osp > nsp)
{
cursor_to (vpos, nsp);
delete_glyphs (osp - nsp);
cursor_to (f, vpos, nsp);
delete_glyphs (f, osp - nsp);
}
else if (nsp > osp)
{
@ -5803,12 +5812,12 @@ update_frame_line (f, vpos)
must delete first to avoid losing data in the insert */
if (endmatch && nlen < olen + nsp - osp)
{
cursor_to (vpos, nlen - endmatch + osp - nsp);
delete_glyphs (olen + nsp - osp - nlen);
cursor_to (f, vpos, nlen - endmatch + osp - nsp);
delete_glyphs (f, olen + nsp - osp - nlen);
olen = nlen - (nsp - osp);
}
cursor_to (vpos, osp);
insert_glyphs (0, nsp - osp);
cursor_to (f, vpos, osp);
insert_glyphs (f, 0, nsp - osp);
}
olen += nsp - osp;
@ -5829,8 +5838,8 @@ update_frame_line (f, vpos)
unnecessary cursor movement. */
if (nlen - tem > 0)
{
cursor_to (vpos, nsp + begmatch);
write_glyphs (nbody + nsp + begmatch, nlen - tem);
cursor_to (f, vpos, nsp + begmatch);
write_glyphs (f, nbody + nsp + begmatch, nlen - tem);
}
}
else if (nlen > olen)
@ -5845,27 +5854,27 @@ update_frame_line (f, vpos)
int out = olen - tem; /* Columns to be overwritten originally. */
int del;
cursor_to (vpos, nsp + begmatch);
cursor_to (f, vpos, nsp + begmatch);
/* Calculate columns we can actually overwrite. */
while (CHAR_GLYPH_PADDING_P (nbody[nsp + begmatch + out]))
out--;
write_glyphs (nbody + nsp + begmatch, out);
write_glyphs (f, nbody + nsp + begmatch, out);
/* If we left columns to be overwritten, we must delete them. */
del = olen - tem - out;
if (del > 0)
delete_glyphs (del);
delete_glyphs (f, del);
/* At last, we insert columns not yet written out. */
insert_glyphs (nbody + nsp + begmatch + out, nlen - olen + del);
insert_glyphs (f, nbody + nsp + begmatch + out, nlen - olen + del);
olen = nlen;
}
else if (olen > nlen)
{
cursor_to (vpos, nsp + begmatch);
write_glyphs (nbody + nsp + begmatch, nlen - tem);
delete_glyphs (olen - nlen);
cursor_to (f, vpos, nsp + begmatch);
write_glyphs (f, nbody + nsp + begmatch, nlen - tem);
delete_glyphs (f, olen - nlen);
olen = nlen;
}
}
@ -5874,8 +5883,8 @@ update_frame_line (f, vpos)
/* If any unerased characters remain after the new line, erase them. */
if (olen > nlen)
{
cursor_to (vpos, nlen);
clear_end_of_line (olen);
cursor_to (f, vpos, nlen);
clear_end_of_line (f, olen);
}
/* Exchange contents between current_frame and new_frame. */
@ -6172,31 +6181,34 @@ window_change_signal (signalnum) /* If we don't have an argument, */
#endif
int old_errno = errno;
struct tty_display_info *tty;
signal (SIGWINCH, window_change_signal);
SIGNAL_THREAD_CHECK (signalnum);
get_frame_size (&width, &height);
/* The frame size change obviously applies to a single
termcap-controlled terminal, but we can't decide which.
Therefore, we resize the frames corresponding to each tty.
*/
for (tty = tty_list; tty; tty = tty->next) {
/* The frame size change obviously applies to a termcap-controlled
frame. Find such a frame in the list, and assume it's the only
one (since the redisplay code always writes to stdout, not a
FILE * specified in the frame structure). Record the new size,
but don't reallocate the data structures now. Let that be done
later outside of the signal handler. */
if (! tty->term_initted)
continue;
{
Lisp_Object tail, frame;
FOR_EACH_FRAME (tail, frame)
{
if (FRAME_TERMCAP_P (XFRAME (frame)))
{
change_frame_size (XFRAME (frame), height, width, 0, 1, 0);
break;
}
}
get_tty_size (fileno (tty->input), &width, &height);
if (width > 5 && height > 2) {
Lisp_Object tail, frame;
FOR_EACH_FRAME (tail, frame)
if (FRAME_TERMCAP_P (XFRAME (frame)) && FRAME_TTY (XFRAME (frame)) == tty)
/* Record the new sizes, but don't reallocate the data
structures now. Let that be done later outside of the
signal handler. */
change_frame_size (XFRAME (frame), height, width, 0, 1, 0);
}
}
errno = old_errno;
}
#endif /* SIGWINCH */
@ -6250,10 +6262,11 @@ change_frame_size (f, newheight, newwidth, pretend, delay, safe)
{
Lisp_Object tail, frame;
if (! FRAME_WINDOW_P (f))
if (FRAME_MSDOS_P (f))
{
/* When using termcap, or on MS-DOS, all frames use
the same screen, so a change in size affects all frames. */
/* On MS-DOS, all frames use the same screen, so a change in
size affects all frames. Termcap now supports multiple
ttys. */
FOR_EACH_FRAME (tail, frame)
if (! FRAME_WINDOW_P (XFRAME (frame)))
change_frame_size_1 (XFRAME (frame), newheight, newwidth,
@ -6333,7 +6346,7 @@ change_frame_size_1 (f, newheight, newwidth, pretend, delay, safe)
newheight - FRAME_TOP_MARGIN (f), 0);
if (FRAME_TERMCAP_P (f) && !pretend)
FrameRows = newheight;
FrameRows (FRAME_TTY (f)) = newheight;
}
if (new_frame_total_cols != FRAME_TOTAL_COLS (f))
@ -6343,7 +6356,7 @@ change_frame_size_1 (f, newheight, newwidth, pretend, delay, safe)
set_window_width (FRAME_MINIBUF_WINDOW (f), new_frame_total_cols, 0);
if (FRAME_TERMCAP_P (f) && !pretend)
FrameCols = newwidth;
FrameCols (FRAME_TTY (f)) = newwidth;
if (WINDOWP (f->tool_bar_window))
XSETFASTINT (XWINDOW (f->tool_bar_window)->total_cols, newwidth);
@ -6393,19 +6406,26 @@ FILE = nil means just close any termscript file currently open. */)
(file)
Lisp_Object file;
{
if (termscript != 0)
{
BLOCK_INPUT;
fclose (termscript);
UNBLOCK_INPUT;
}
termscript = 0;
struct tty_display_info *tty;
if (! FRAME_TERMCAP_P (SELECTED_FRAME ()))
error ("Current frame is not on a tty device");
tty = CURTTY ();
if (tty->termscript != 0)
{
BLOCK_INPUT;
fclose (tty->termscript);
UNBLOCK_INPUT;
}
tty->termscript = 0;
if (! NILP (file))
{
file = Fexpand_file_name (file, Qnil);
termscript = fopen (SDATA (file), "w");
if (termscript == 0)
tty->termscript = fopen (SDATA (file), "w");
if (tty->termscript == 0)
report_file_error ("Opening termscript", Fcons (file, Qnil));
}
return Qnil;
@ -6413,23 +6433,36 @@ FILE = nil means just close any termscript file currently open. */)
DEFUN ("send-string-to-terminal", Fsend_string_to_terminal,
Ssend_string_to_terminal, 1, 1, 0,
Ssend_string_to_terminal, 1, 2, 0,
doc: /* Send STRING to the terminal without alteration.
Control characters in STRING will have terminal-dependent effects. */)
(string)
Control characters in STRING will have terminal-dependent effects.
Optional parameter TERMINAL specifies the tty terminal device to use.
It may be a terminal id, a frame, or nil for the terminal used by the
currently selected frame. */)
(string, terminal)
Lisp_Object string;
Lisp_Object terminal;
{
struct terminal *t = get_tty_terminal (terminal, 1);
struct tty_display_info *tty;
/* ??? Perhaps we should do something special for multibyte strings here. */
CHECK_STRING (string);
BLOCK_INPUT;
fwrite (SDATA (string), 1, SBYTES (string), stdout);
fflush (stdout);
if (termscript)
if (!t)
error ("Unknown terminal device");
tty = t->display_info.tty;
if (tty->termscript)
{
fwrite (SDATA (string), 1, SBYTES (string),
termscript);
fflush (termscript);
fwrite (SDATA (string), 1, SBYTES (string), tty->termscript);
fflush (tty->termscript);
}
fwrite (SDATA (string), 1, SBYTES (string), tty->output);
fflush (tty->output);
UNBLOCK_INPUT;
return Qnil;
}
@ -6447,8 +6480,7 @@ terminate any keyboard macro currently executing. */)
if (noninteractive)
putchar (07);
else
ring_bell ();
fflush (stdout);
ring_bell (XFRAME (selected_frame));
}
else
bitch_at_user ();
@ -6464,8 +6496,7 @@ bitch_at_user ()
else if (!INTERACTIVE) /* Stop executing a keyboard macro. */
error ("Keyboard macro terminated by a command ringing the bell");
else
ring_bell ();
fflush (stdout);
ring_bell (XFRAME (selected_frame));
}
@ -6748,8 +6779,6 @@ pass nil for VARIABLE. */)
Initialization
***********************************************************************/
char *terminal_type;
/* Initialization done when Emacs fork is started, before doing stty.
Determine terminal type and set terminal_driver. Then invoke its
decoding routine to set up variables in the terminal package. */
@ -6757,6 +6786,8 @@ char *terminal_type;
void
init_display ()
{
char *terminal_type;
#ifdef HAVE_X_WINDOWS
extern int display_arg;
#endif
@ -6766,14 +6797,23 @@ init_display ()
SET_CHAR_GLYPH_FROM_GLYPH (space_glyph, ' ');
space_glyph.charpos = -1;
meta_key = 0;
inverse_video = 0;
cursor_in_echo_area = 0;
terminal_type = (char *) 0;
/* Now is the time to initialize this; it's used by init_sys_modes
during startup. */
Vwindow_system = Qnil;
Vinitial_window_system = Qnil;
/* SIGWINCH needs to be handled no matter what display we start
with. Otherwise newly opened tty frames will not resize
automatically. */
#ifdef SIGWINCH
#ifndef CANNOT_DUMP
if (initialized)
#endif /* CANNOT_DUMP */
signal (SIGWINCH, window_change_signal);
#endif /* SIGWINCH */
/* If the user wants to use a window system, we shouldn't bother
initializing the terminal. This is especially important when the
@ -6809,7 +6849,7 @@ init_display ()
#endif
)
{
Vwindow_system = intern ("x");
Vinitial_window_system = intern ("x");
#ifdef HAVE_X11
Vwindow_system_version = make_number (11);
#else
@ -6829,7 +6869,7 @@ init_display ()
#ifdef HAVE_NTGUI
if (!inhibit_window_system)
{
Vwindow_system = intern ("w32");
Vinitial_window_system = intern ("w32");
Vwindow_system_version = make_number (1);
adjust_frame_glyphs_initially ();
return;
@ -6839,7 +6879,7 @@ init_display ()
#ifdef MAC_OS
if (!inhibit_window_system)
{
Vwindow_system = intern ("mac");
Vinitial_window_system = intern ("mac");
Vwindow_system_version = make_number (1);
adjust_frame_glyphs_initially ();
return;
@ -6891,8 +6931,38 @@ For types not defined in VMS, use define emacs_term \"TYPE\".\n\
}
#endif /* VMS */
term_init (terminal_type);
{
struct terminal *t;
struct frame *f = XFRAME (selected_frame);
/* Open a display on the controlling tty. */
t = init_tty (0, terminal_type, 1); /* Errors are fatal. */
/* Convert the initial frame to use the new display. */
if (f->output_method != output_initial)
abort ();
f->output_method = t->type;
f->terminal = t;
t->reference_count++;
t->display_info.tty->top_frame = selected_frame;
change_frame_size (XFRAME (selected_frame),
FrameRows (t->display_info.tty),
FrameCols (t->display_info.tty), 0, 0, 1);
/* Delete the initial terminal. */
if (--initial_terminal->reference_count == 0
&& initial_terminal->delete_terminal_hook)
(*initial_terminal->delete_terminal_hook) (initial_terminal);
/* Update frame parameters to reflect the new type. */
Fmodify_frame_parameters (selected_frame, Fcons (Fcons (Qwindow_system, Qnil), Qnil));
Fmodify_frame_parameters
(selected_frame, Fcons (Fcons (Qtty_type,
Ftty_type (selected_frame)), Qnil));
Fmodify_frame_parameters (selected_frame, Fcons (Fcons (Qtty, Qnil), Qnil));
}
{
struct frame *sf = SELECTED_FRAME ();
int width = FRAME_TOTAL_COLS (sf);
@ -6909,13 +6979,6 @@ For types not defined in VMS, use define emacs_term \"TYPE\".\n\
adjust_frame_glyphs_initially ();
calculate_costs (XFRAME (selected_frame));
#ifdef SIGWINCH
#ifndef CANNOT_DUMP
if (initialized)
#endif /* CANNOT_DUMP */
signal (SIGWINCH, window_change_signal);
#endif /* SIGWINCH */
/* Set up faces of the initial terminal frame of a dumped Emacs. */
if (initialized
&& !noninteractive
@ -6926,7 +6989,7 @@ For types not defined in VMS, use define emacs_term \"TYPE\".\n\
and internal_terminal_init. */
&& (strcmp (terminal_type, "internal") != 0 || inhibit_window_system)
#endif
&& NILP (Vwindow_system))
&& NILP (Vinitial_window_system))
{
/* For the initial frame, we don't have any way of knowing what
are the foreground and background colors of the terminal. */
@ -7038,8 +7101,8 @@ A non-nil value is useful if the terminal can automatically preserve
Emacs's frame display when you reenter Emacs.
It is up to you to set this variable if your terminal can do that. */);
DEFVAR_LISP ("window-system", &Vwindow_system,
doc: /* Name of window system that Emacs is displaying through.
DEFVAR_LISP ("initial-window-system", &Vinitial_window_system,
doc: /* Name of the window system that Emacs uses for the first frame.
The value is a symbol--for instance, `x' for X windows.
The value is nil if Emacs is using a text-only terminal. */);
@ -7082,7 +7145,7 @@ If nil, never pre-empt redisplay. */);
if (noninteractive)
#endif
{
Vwindow_system = Qnil;
Vinitial_window_system = Qnil;
Vwindow_system_version = Qnil;
}
}

43
src/emacs.c
View file

@ -57,6 +57,7 @@ Boston, MA 02110-1301, USA. */
#include "blockinput.h"
#include "syssignal.h"
#include "process.h"
#include "frame.h"
#include "termhooks.h"
#include "keyboard.h"
#include "keymap.h"
@ -214,7 +215,7 @@ static unsigned long heap_bss_diff;
#ifdef HAVE_WINDOW_SYSTEM
extern Lisp_Object Vwindow_system;
extern Lisp_Object Vinitial_window_system;
#endif /* HAVE_WINDOW_SYSTEM */
extern Lisp_Object Vauto_save_list_file_name;
@ -1296,6 +1297,9 @@ main (argc, argv
faces, and the face implementation uses some symbols as
face names. */
syms_of_xfaces ();
/* XXX syms_of_keyboard uses some symbols in keymap.c. It would
be better to arrange things not to have this dependency. */
syms_of_keymap ();
/* Call syms_of_keyboard before init_window_once because
keyboard sets up symbols that include some face names that
the X support will want to use. This can happen when
@ -1493,10 +1497,10 @@ main (argc, argv
/* egetenv is a pretty low-level facility, which may get called in
many circumstances; it seems flimsy to put off initializing it
until calling init_callproc. */
set_process_environment ();
set_initial_environment ();
/* AIX crashes are reported in system versions 3.2.3 and 3.2.4
if this is not done. Do it after set_process_environment so that we
don't pollute Vprocess_environment. */
if this is not done. Do it after set_global_environment so that we
don't pollute Vglobal_environment. */
/* Setting LANG here will defeat the startup locale processing... */
#ifdef AIX3_2
putenv ("LANG=C");
@ -1567,7 +1571,7 @@ main (argc, argv
#endif /* CLASH_DETECTION */
syms_of_indent ();
syms_of_insdel ();
syms_of_keymap ();
/* syms_of_keymap (); */
syms_of_macros ();
syms_of_marker ();
syms_of_minibuf ();
@ -1578,6 +1582,7 @@ main (argc, argv
syms_of_frame ();
#endif
syms_of_syntax ();
syms_of_terminal ();
syms_of_term ();
syms_of_undo ();
#ifdef HAVE_SOUND
@ -1662,13 +1667,7 @@ main (argc, argv
#endif /* HAVE_NTGUI */
}
if (!noninteractive)
{
#ifdef VMS
init_vms_input ();/* init_display calls get_frame_size, that needs this. */
#endif /* VMS */
init_display (); /* Determine terminal type. init_sys_modes uses results. */
}
init_process (); /* init_display uses add_keyboard_wait_descriptor. */
#ifndef MAC_OS8
/* Called before init_window_once for Mac OS Classic. */
init_keyboard (); /* This too must precede init_sys_modes. */
@ -1676,7 +1675,13 @@ main (argc, argv
#ifdef VMS
init_vmsproc (); /* And this too. */
#endif /* VMS */
init_sys_modes (); /* Init system terminal modes (RAW or CBREAK, etc.). */
if (!noninteractive)
{
#ifdef VMS
init_vms_input ();/* init_display calls get_tty_size, that needs this. */
#endif /* VMS */
init_display (); /* Determine terminal type. Calls init_sys_modes. */
}
init_fns ();
init_xdisp ();
#ifdef HAVE_WINDOW_SYSTEM
@ -1689,7 +1694,6 @@ main (argc, argv
#ifdef VMS
init_vmsfns ();
#endif /* VMS */
init_process ();
#ifdef HAVE_SOUND
init_sound ();
#endif
@ -2102,15 +2106,14 @@ shut_down_emacs (sig, no_x, stuff)
if (EMACS_GET_TTY_PGRP (0, &tpgrp) != -1
&& tpgrp == pgrp)
{
fflush (stdout);
reset_sys_modes ();
reset_all_sys_modes ();
if (sig && sig != SIGTERM)
fprintf (stderr, "Fatal error (%d)", sig);
}
}
#else
fflush (stdout);
reset_sys_modes ();
reset_all_sys_modes ();
#endif
stuff_buffered_input (stuff);
@ -2132,9 +2135,9 @@ shut_down_emacs (sig, no_x, stuff)
#if 0 /* This triggers a bug in XCloseDisplay and is not needed. */
#ifdef HAVE_X_WINDOWS
/* It's not safe to call intern here. Maybe we are crashing. */
if (!noninteractive && SYMBOLP (Vwindow_system)
&& SCHARS (SYMBOL_NAME (Vwindow_system)) == 1
&& SREF (SYMBOL_NAME (Vwindow_system), 0) == 'x'
if (!noninteractive && SYMBOLP (Vinitial_window_system)
&& SCHARS (SYMBOL_NAME (Vinitial_window_system)) == 1
&& SREF (SYMBOL_NAME (Vinitial_window_system), 0) == 'x'
&& ! no_x)
Fx_close_current_connection ();
#endif /* HAVE_X_WINDOWS */

10
src/eval.c
View file

@ -1280,7 +1280,11 @@ unwind_to_catch (catch, value)
#if HAVE_X_WINDOWS
/* If x_catch_errors was done, turn it off now.
(First we give unbind_to a chance to do that.) */
#if 0 /* This would disable x_catch_errors after x_connection_closed.
* The catch must remain in effect during that delicate
* state. --lorentey */
x_fully_uncatch_errors ();
#endif
#endif
byte_stack_list = catch->byte_stack;
@ -1458,9 +1462,11 @@ internal_condition_case (bfun, handlers, hfun)
/* Since Fsignal will close off all calls to x_catch_errors,
we will get the wrong results if some are not closed now. */
#if 0 /* Fsignal doesn't do that anymore. --lorentey */
#if HAVE_X_WINDOWS
if (x_catching_errors ())
abort ();
#endif
#endif
c.tag = Qnil;
@ -1506,9 +1512,11 @@ internal_condition_case_1 (bfun, arg, handlers, hfun)
/* Since Fsignal will close off all calls to x_catch_errors,
we will get the wrong results if some are not closed now. */
#if 0 /* Fsignal doesn't do that anymore. --lorentey */
#if HAVE_X_WINDOWS
if (x_catching_errors ())
abort ();
#endif
#endif
c.tag = Qnil;
@ -1557,9 +1565,11 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
/* Since Fsignal will close off all calls to x_catch_errors,
we will get the wrong results if some are not closed now. */
#if 0 /* Fsignal doesn't do that anymore. --lorentey */
#if HAVE_X_WINDOWS
if (x_catching_errors ())
abort ();
#endif
#endif
c.tag = Qnil;

6
src/fileio.c
View file

@ -78,6 +78,8 @@ extern int errno;
#include "coding.h"
#include "window.h"
#include "blockinput.h"
#include "frame.h"
#include "dispextern.h"
#ifdef WINDOWSNT
#define NOMINMAX 1
@ -5825,7 +5827,7 @@ auto_save_error (error)
char *msgbuf;
USE_SAFE_ALLOCA;
ring_bell ();
ring_bell (XFRAME (selected_frame));
args[0] = build_string ("Auto-saving %s: %s");
args[1] = current_buffer->name;
@ -6387,7 +6389,7 @@ and `read-file-name-function'. */)
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
#ifdef DOS_NT
/* homedir can be NULL in temacs, since Vprocess_environment is not
/* homedir can be NULL in temacs, since Vglobal_environment is not
yet set up. We shouldn't crash in that case. */
if (homedir != 0)
{

7
src/fns.c
View file

@ -3236,7 +3236,8 @@ is nil and `use-dialog-box' is non-nil. */)
{
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
if (FRAME_WINDOW_P (SELECTED_FRAME ())
&& (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
{
@ -3275,6 +3276,7 @@ is nil and `use-dialog-box' is non-nil. */)
Fraise_frame (mini_frame);
}
temporarily_switch_to_single_kboard (SELECTED_FRAME ());
obj = read_filtered_event (1, 0, 0, 0, Qnil);
cursor_in_echo_area = 0;
/* If we need to quit, quit with cursor_in_echo_area = 0. */
@ -3367,7 +3369,8 @@ is nil, and `use-dialog-box' is non-nil. */)
CHECK_STRING (prompt);
#ifdef HAVE_MENUS
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
if (FRAME_WINDOW_P (SELECTED_FRAME ())
&& (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& have_menus_p ())
{

3
src/fontset.c
View file

@ -49,6 +49,7 @@ Boston, MA 02110-1301, USA. */
#ifdef MAC_OS
#include "macterm.h"
#endif
#include "termhooks.h"
#ifdef FONTSET_DEBUG
#undef xassert
@ -1347,7 +1348,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
STORE_XCHAR2B (&char2b, c1, c2);
else
STORE_XCHAR2B (&char2b, 0, c1);
rif->encode_char (c, &char2b, fontp, NULL);
FRAME_RIF (f)->encode_char (c, &char2b, fontp, NULL);
code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
}
return Fcons (build_string (face->font_name), make_number (code));

Some files were not shown because too many files have changed in this diff Show more