From: Karoly Lorentey Date: Sat, 14 Oct 2006 17:36:28 +0000 (+0000) Subject: Merged from emacs@sv.gnu.org X-Git-Tag: emacs-pretest-23.0.90~11236^2~141^2~23 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a;p=emacs.git Merged from emacs@sv.gnu.org Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-413 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-414 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-415 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-416 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-417 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-418 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-419 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-420 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-421 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-422 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-423 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-424 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-425 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-426 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-427 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-428 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-429 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-430 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-431 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-432 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-433 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-434 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-435 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-436 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-437 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-438 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-439 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-440 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-441 lisp/url/url-methods.el: Fix format error when http_proxy is empty string * emacs@sv.gnu.org/emacs--devo--0--patch-442 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-443 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-444 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-445 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-446 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-447 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-448 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-449 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-450 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-451 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-452 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-453 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-454 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-455 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-456 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-457 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-458 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-459 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-460 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-461 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-462 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-463 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-464 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-465 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-466 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-467 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-468 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-469 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-470 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-471 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-472 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-473 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-128 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-129 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-130 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-131 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-132 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-133 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-134 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-135 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-136 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-137 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-138 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-139 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-140 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-141 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-142 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-143 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-144 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-145 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-146 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-147 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-148 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-149 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582 --- 12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a diff --cc lisp/emulation/cua-base.el index b16ae17eda0,2fbd09600bd..236e3e2c9ad --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@@ -1097,73 -1097,79 +1097,79 @@@ If ARG is the atom `-', scroll upward b ;;; Pre-command hook (defun cua--pre-command-handler-1 () - (let ((movement (eq (get this-command 'CUA) 'move))) - - ;; Cancel prefix key timeout if user enters another key. - (when cua--prefix-override-timer - (if (timerp cua--prefix-override-timer) - (cancel-timer cua--prefix-override-timer)) - (setq cua--prefix-override-timer nil)) - - ;; Handle shifted cursor keys and other movement commands. - ;; If region is not active, region is activated if key is shifted. - ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC). - ;; If rectangle is active, expand rectangle in specified direction and ignore the movement. - (if movement - (cond - ((if window-system - (memq 'shift (event-modifiers - (aref (this-single-command-raw-keys) 0))) - (or - (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 '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))) - (string-match "S-" (symbol-name ev))))))) - (unless mark-active - (push-mark-command nil t)) - (setq cua--last-region-shifted t) - (setq cua--explicit-region-start nil)) - ((or cua--explicit-region-start cua--rectangle) - (unless mark-active - (push-mark-command nil nil))) - (t - ;; If we set mark-active to nil here, the region highlight will not be - ;; removed by the direct_output_ commands. - (setq deactivate-mark t))) - - ;; Handle delete-selection property on other commands - (if (and mark-active (not deactivate-mark)) - (let* ((ds (or (get this-command 'delete-selection) - (get this-command 'pending-delete))) - (nc (cond - ((not ds) nil) - ((eq ds 'yank) - 'cua-paste) - ((eq ds 'kill) - (if cua--rectangle - 'cua-copy-rectangle - 'cua-copy-region)) - ((eq ds 'supersede) - (if cua--rectangle - 'cua-delete-rectangle - 'cua-delete-region)) - (t - (if cua--rectangle - 'cua-delete-rectangle ;; replace? - 'cua-replace-region))))) - (if nc - (setq this-original-command this-command - this-command nc))))) - - ;; Detect extension of rectangles by mouse or other movement - (setq cua--buffer-and-point-before-command - (if cua--rectangle (cons (current-buffer) (point)))))) + ;; Cancel prefix key timeout if user enters another key. + (when cua--prefix-override-timer + (if (timerp cua--prefix-override-timer) + (cancel-timer cua--prefix-override-timer)) + (setq cua--prefix-override-timer nil)) + + (cond + ;; Only symbol commands can have necessary properties + ((not (symbolp this-command)) + nil) + + ;; Handle delete-selection property on non-movement commands + ((not (eq (get this-command 'CUA) 'move)) + (when (and mark-active (not deactivate-mark)) + (let* ((ds (or (get this-command 'delete-selection) + (get this-command 'pending-delete))) + (nc (cond + ((not ds) nil) + ((eq ds 'yank) + 'cua-paste) + ((eq ds 'kill) + (if cua--rectangle + 'cua-copy-rectangle + 'cua-copy-region)) + ((eq ds 'supersede) + (if cua--rectangle + 'cua-delete-rectangle + 'cua-delete-region)) + (t + (if cua--rectangle + 'cua-delete-rectangle ;; replace? + 'cua-replace-region))))) + (if nc + (setq this-original-command this-command + this-command nc))))) + + ;; Handle shifted cursor keys and other movement commands. + ;; If region is not active, region is activated if key is shifted. + ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC). + ;; If rectangle is active, expand rectangle in specified direction and ignore the movement. + ((if window-system + (memq 'shift (event-modifiers + (aref (this-single-command-raw-keys) 0))) + (or + (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))) + (string-match "S-" (symbol-name ev))))))) + (unless mark-active + (push-mark-command nil t)) + (setq cua--last-region-shifted t) + (setq cua--explicit-region-start nil)) + + ;; Set mark if user explicitly said to do so + ((or cua--explicit-region-start cua--rectangle) + (unless mark-active + (push-mark-command nil nil))) + + ;; Else clear mark after this command. + (t + ;; If we set mark-active to nil here, the region highlight will not be + ;; removed by the direct_output_ commands. + (setq deactivate-mark t))) + + ;; Detect extension of rectangles by mouse or other movement + (setq cua--buffer-and-point-before-command + (if cua--rectangle (cons (current-buffer) (point))))) (defun cua--pre-command-handler () (when cua-mode diff --cc lisp/server.el index c40b36fa752,fc0f90f6f05..73d36ca4b18 --- a/lisp/server.el +++ b/lisp/server.el @@@ -568,274 -297,101 +568,274 @@@ The following commands are accepted by (when prev (setq string (concat prev string)) (process-put proc 'previous-string nil))) - ;; If the input is multiple lines, - ;; process each line individually. - (while (string-match "\n" string) - (let ((request (substring string 0 (match-beginning 0))) - (coding-system (and default-enable-multibyte-characters - (or file-name-coding-system - default-file-name-coding-system))) - client nowait eval - (files nil) - (lineno 1) - (tmp-frame nil) ; Sometimes used to embody the selected display. - (columnno 0)) - ;; Remove this line from STRING. - (setq string (substring string (match-end 0))) - (setq client (cons proc nil)) - (while (string-match "[^ ]* " request) - (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) - (setq request (substring request (match-end 0))) - (cond - ((equal "-nowait" arg) (setq nowait t)) - ((equal "-eval" arg) (setq eval t)) - ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) - (let ((display (server-unquote-arg (match-string 1 request)))) - (setq request (substring request (match-end 0))) - (condition-case err - (setq tmp-frame (server-select-display display)) - (error (process-send-string proc (nth 1 err)) - (setq request ""))))) - ;; ARG is a line number option. - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq lineno (string-to-number (substring arg 1)))) - ;; ARG is line number:column option. - ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) - (setq lineno (string-to-number (match-string 1 arg)) - columnno (string-to-number (match-string 2 arg)))) - (t - ;; Undo the quoting that emacsclient does - ;; for certain special characters. - (setq arg (server-unquote-arg arg)) - ;; Now decode the file name if necessary. - (if coding-system - (setq arg (decode-coding-string arg coding-system))) - (if eval - (let* (errorp - (v (condition-case errobj - (eval (car (read-from-string arg))) - (error (setq errorp t) errobj)))) - (when v - (with-temp-buffer - (let ((standard-output (current-buffer))) - (if errorp (princ "error: ")) - (pp v) - ;; Suppress the error rose when the pipe to PROC is closed. - (condition-case err - (process-send-region proc (point-min) (point-max)) - (file-error nil) - (error nil)) - )))) - ;; ARG is a file name. - ;; Collapse multiple slashes to single slashes. - (setq arg (command-line-normalize-file-name arg)) - (push (list arg lineno columnno) files)) - (setq lineno 1) - (setq columnno 0))))) - (when files - (run-hooks 'pre-command-hook) - (server-visit-files files client nowait) - (run-hooks 'post-command-hook)) - ;; CLIENT is now a list (CLIENTNUM BUFFERS...) - (if (null (cdr client)) - ;; This client is empty; get rid of it immediately. - (progn - (delete-process proc) - (server-log "Close empty client" proc)) - ;; We visited some buffer for this client. - (or nowait (push client server-clients)) - (unless (or isearch-mode (minibufferp)) - (server-switch-buffer (nth 1 client)) - (run-hooks 'server-switch-hook) - (unless nowait - (message "%s" (substitute-command-keys - "When done with a buffer, type \\[server-edit]"))))) - ;; If the temporary frame is still the selected frame, make it - ;; real. If not (which can happen if the user's customizations - ;; call pop-to-buffer etc.), delete it to avoid preserving the - ;; connection after the last real frame is deleted. - (if tmp-frame - (if (eq (selected-frame) tmp-frame) - (set-frame-parameter tmp-frame 'visibility t) - (delete-frame tmp-frame))))) - ;; Save for later any partial line that remains. - (when (> (length string) 0) - (process-put proc 'previous-string string))) + (condition-case err + (progn + (server-add-client proc) + ;; If the input is multiple lines, + ;; process each line individually. + (while (string-match "\n" string) + (let ((request (substring string 0 (match-beginning 0))) + (coding-system (and default-enable-multibyte-characters + (or file-name-coding-system + default-file-name-coding-system))) + (client (server-client proc)) + current-frame + nowait ; t if emacsclient does not want to wait for us. + frame ; The frame that was opened for the client (if any). + display ; Open the frame on this display. + dontkill ; t if the client should not be killed. + env + dir + (files nil) + (lineno 1) + (columnno 0)) + ;; Remove this line from STRING. + (setq string (substring string (match-end 0))) + (while (string-match " *[^ ]* " request) + (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) + (setq request (substring request (match-end 0))) + (cond + ;; -version CLIENT-VERSION: + ;; Check version numbers, signal an error if there is a mismatch. + ((and (equal "-version" arg) + (string-match "\\([0-9.]+\\) " request)) + (let* ((client-version (match-string 1 request)) + (truncated-emacs-version + (substring emacs-version 0 (length client-version)))) + (setq request (substring request (match-end 0))) + (if (equal client-version truncated-emacs-version) + (progn + (server-send-string proc "-good-version \n") + (server-client-set client 'version client-version)) + (error (concat "Version mismatch: Emacs is " + truncated-emacs-version + ", emacsclient is " client-version))))) + + ;; -nowait: Emacsclient won't wait for a result. + ((equal "-nowait" arg) (setq nowait t)) + + ;; -current-frame: Don't create frames. + ((equal "-current-frame" arg) (setq current-frame t)) + + ;; -display DISPLAY: + ;; Open X frames on the given display instead of the default. + ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) + (setq display (match-string 1 request) + request (substring request (match-end 0)))) + + ;; -window-system: Open a new X frame. + ((equal "-window-system" arg) + (unless (server-client-get client 'version) + (error "Protocol error; make sure to use the correct version of emacsclient")) + (unless current-frame + (if (fboundp 'x-create-frame) + (let ((params (if nowait + ;; Flag frame as client-created, but use a dummy client. + ;; This will prevent the frame from being deleted when + ;; emacsclient quits while also preventing + ;; `server-save-buffers-kill-terminal' from unexpectedly + ;; killing emacs on that frame. + (list (cons 'client 'nowait) (cons 'environment env)) + (list (cons 'client proc) (cons 'environment env))))) + (setq frame (make-frame-on-display + (or display + (frame-parameter nil 'display) + (getenv "DISPLAY") + (error "Please specify display")) + params)) + (server-log (format "%s created" frame) proc) + ;; XXX We need to ensure the parameters are + ;; really set because Emacs forgets unhandled + ;; initialization parameters for X frames at + ;; the moment. + (modify-frame-parameters frame params) + (select-frame frame) + (server-client-set client 'frame frame) + (server-client-set client 'terminal (frame-terminal frame)) + + ;; Display *scratch* by default. + (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) + (if dir (setq default-directory dir)) + + (setq dontkill t)) + ;; This emacs does not support X. + (server-log "Window system unsupported" proc) + (server-send-string proc "-window-system-unsupported \n") + (setq dontkill t)))) + + ;; -resume: Resume a suspended tty frame. + ((equal "-resume" arg) + (let ((terminal (server-client-get client 'terminal))) + (setq dontkill t) + (when (eq (terminal-live-p terminal) t) + (resume-tty terminal)))) + + ;; -suspend: Suspend the client's frame. (In case we + ;; get out of sync, and a C-z sends a SIGTSTP to + ;; emacsclient.) + ((equal "-suspend" arg) + (let ((terminal (server-client-get client 'terminal))) + (setq dontkill t) + (when (eq (terminal-live-p terminal) t) + (suspend-tty terminal)))) + + ;; -ignore COMMENT: Noop; useful for debugging emacsclient. + ;; (The given comment appears in the server log.) + ((and (equal "-ignore" arg) (string-match "\\([^ ]*\\) " request)) + (setq dontkill t + request (substring request (match-end 0)))) + + ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. + ((and (equal "-tty" arg) (string-match "\\([^ ]*\\) \\([^ ]*\\) " request)) + (let ((tty (server-unquote-arg (match-string 1 request))) + (type (server-unquote-arg (match-string 2 request)))) + (setq request (substring request (match-end 0))) + (unless (server-client-get client 'version) + (error "Protocol error; make sure you use the correct version of emacsclient")) + (unless current-frame + (server-with-environment env + '("LANG" "LC_CTYPE" "LC_ALL" + ;; For tgetent(3); list according to ncurses(3). + "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" + "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" + "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" + "TERMINFO_DIRS" "TERMPATH") + (setq frame (make-frame-on-tty tty type + ;; Ignore nowait here; we always need to clean + ;; up opened ttys when the client dies. + `((client . ,proc) + (environment . ,env))))) + (select-frame frame) + (server-client-set client 'frame frame) + (server-client-set client 'tty (terminal-name frame)) + (server-client-set client 'terminal (frame-terminal frame)) + + ;; Display *scratch* by default. + (switch-to-buffer (get-buffer-create "*scratch*") 'norecord) + (if dir (setq default-directory dir)) + + ;; Reply with our pid. + (server-send-string proc (concat "-emacs-pid " (number-to-string (emacs-pid)) "\n")) + (setq dontkill t)))) + + ;; -position LINE: Go to the given line in the next file. + ((and (equal "-position" arg) (string-match "\\(\\+[0-9]+\\) " request)) + (setq lineno (string-to-number (substring (match-string 1 request) 1)) + request (substring request (match-end 0)))) + + ;; -position LINE:COLUMN: Set point to the given position in the next file. + ((and (equal "-position" arg) (string-match "\\+\\([0-9]+\\):\\([0-9]+\\) " request)) + (setq lineno (string-to-number (match-string 1 request)) + columnno (string-to-number (match-string 2 request)) + request (substring request (match-end 0)))) + + ;; -file FILENAME: Load the given file. + ((and (equal "-file" arg) (string-match "\\([^ ]+\\) " request)) + (let ((file (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq file (decode-coding-string file coding-system))) + (setq file (command-line-normalize-file-name file)) + (push (list file lineno columnno) files) + (server-log (format "New file: %s (%d:%d)" file lineno columnno) proc)) + (setq lineno 1 + columnno 0)) + + ;; -eval EXPR: Evaluate a Lisp expression. + ((and (equal "-eval" arg) (string-match "\\([^ ]+\\) " request)) + (let ((expr (server-unquote-arg (match-string 1 request)))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq expr (decode-coding-string expr coding-system))) + (let ((v (eval (car (read-from-string expr))))) + (when (and (not frame) v) + (with-temp-buffer + (let ((standard-output (current-buffer))) + (pp v) + (server-send-string + proc (format "-print %s\n" + (server-quote-arg + (buffer-substring-no-properties (point-min) + (point-max))))))))) + (setq lineno 1 + columnno 0))) + + ;; -env NAME=VALUE: An environment variable. + ((and (equal "-env" arg) (string-match "\\([^ ]+\\) " request)) + (let ((var (server-unquote-arg (match-string 1 request)))) + ;; XXX Variables should be encoded as in getenv/setenv. + (setq request (substring request (match-end 0))) + (setq env (cons var env)))) + + ;; -dir DIRNAME: The cwd of the emacsclient process. + ((and (equal "-dir" arg) (string-match "\\([^ ]+\\) " request)) + (setq dir (server-unquote-arg (match-string 1 request))) + (setq request (substring request (match-end 0))) + (if coding-system + (setq dir (decode-coding-string dir coding-system))) + (setq dir (command-line-normalize-file-name dir))) + + ;; Unknown command. + (t (error "Unknown command: %s" arg))))) + + (let (buffers) + (when files + (run-hooks 'pre-command-hook) + (setq buffers (server-visit-files files client nowait)) + (run-hooks 'post-command-hook)) + + (when frame + (with-selected-frame frame + (display-startup-echo-area-message) + (unless inhibit-splash-screen + (condition-case err + ;; This looks scary because `fancy-splash-screens' + ;; will call `recursive-edit' from a process filter. + ;; However, that should be safe to do now. - (display-splash-screen) ++ (display-splash-screen t) + ;; `recursive-edit' will throw an error if Emacs is + ;; already doing a recursive edit elsewhere. Catch it + ;; here so that we can finish normally. + (error nil))))) + + ;; Delete the client if necessary. + (cond + (nowait + ;; Client requested nowait; return immediately. + (server-log "Close nowait client" proc) + (server-delete-client proc)) + ((and (not dontkill) (null buffers)) + ;; This client is empty; get rid of it immediately. + (server-log "Close empty client" proc) + (server-delete-client proc))) + (cond + ((or isearch-mode (minibufferp)) + nil) + ((and frame (null buffers)) + (message "%s" (substitute-command-keys + "When done with this frame, type \\[delete-frame]"))) + ((not (null buffers)) + (server-switch-buffer (car buffers)) + (run-hooks 'server-switch-hook) + (unless nowait + (message "%s" (substitute-command-keys + "When done with a buffer, type \\[server-edit]")))))))) + + ;; Save for later any partial line that remains. + (when (> (length string) 0) + (process-put proc 'previous-string string))) + ;; condition-case + (error (ignore-errors + (server-send-string + proc (concat "-error " (server-quote-arg (error-message-string err)))) + (setq string "") + (server-log (error-message-string err) proc) + (delete-process proc))))) (defun server-goto-line-column (file-line-col) + "Move point to the position indicated in FILE-LINE-COL. +FILE-LINE-COL should be a three-element list as described in +`server-visit-files'." (goto-line (nth 1 file-line-col)) (let ((column-number (nth 2 file-line-col))) (if (> column-number 0) diff --cc lisp/startup.el index b96503603c2,664fd285754..59bcabf4a9e --- a/lisp/startup.el +++ b/lisp/startup.el @@@ -784,16 -779,15 +784,17 @@@ opening the first frame (e.g. open a co (custom-reevaluate-setting 'mouse-wheel-up-event) (custom-reevaluate-setting 'file-name-shadow-mode) (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 @@@ -1355,20 -1360,14 +1354,19 @@@ mouse. (setq splash-buffer (current-buffer)) (catch 'stop-splashing (unwind-protect - (let ((map (make-sparse-keymap)) - (cursor-type nil)) - (use-local-map map) - (define-key map [switch-frame] 'ignore) + (let* ((map (make-sparse-keymap)) ++ (cursor-type nil) + (overriding-local-map map) + ;; Catch if our frame is deleted; the delete-frame + ;; event is unreliable and is handled by + ;; `special-event-map' anyway. + (delete-frame-functions (cons 'fancy-splash-delete-frame + delete-frame-functions))) (define-key map [t] 'fancy-splash-default-action) (define-key map [mouse-movement] 'ignore) (define-key map [mode-line t] 'ignore) + (define-key map [select-window] 'ignore) - (setq cursor-type nil - display-hourglass nil + (setq display-hourglass nil minor-mode-map-alist nil emulation-mode-map-alists nil buffer-undo-list t @@@ -1384,11 -1384,8 +1383,11 @@@ (setq display-hourglass old-hourglass minor-mode-map-alist old-minor-mode-map-alist emulation-mode-map-alists old-emulation-mode-map-alists) - (kill-buffer splash-buffer))))) + (kill-buffer splash-buffer) + (when (frame-live-p frame) + (select-frame frame) + (switch-to-buffer fancy-splash-outer-buffer)))))) - ;; If hide-on-input is non-nil, don't hide the buffer on input. + ;; If hide-on-input is nil, don't hide the buffer on input. (if (or (window-minibuffer-p) (window-dedicated-p (selected-window))) (pop-to-buffer (current-buffer)) @@@ -1401,12 -1399,18 +1401,19 @@@ Warning Warning!!! Pure space overflo (let (fancy-splash-outer-buffer) (fancy-splash-head) (dolist (text fancy-splash-text) - (apply #'fancy-splash-insert text)) + (apply #'fancy-splash-insert text) + (insert "\n")) + (skip-chars-backward "\n") + (delete-region (point) (point-max)) + (insert "\n") (fancy-splash-tail) (set-buffer-modified-p nil) + (setq buffer-read-only t) + (if (and view-read-only (not view-mode)) + (view-mode-enter nil 'kill-buffer)) (goto-char (point-min))))) + (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. Returning non-nil does not mean we should necessarily @@@ -1557,44 -1562,52 +1565,50 @@@ Emacs is Free Software--Free as in Free of Emacs and modify it; type \\[describe-copying] to see the conditions. Type \\[describe-distribution] for information on getting the latest version.")))) - ;; The rest of the startup screen is the same on all - ;; kinds of terminals. - - ;; Give information on recovering, if there was a crash. - (and auto-save-list-file-prefix - ;; Don't signal an error if the - ;; directory for auto-save-list files - ;; does not yet exist. - (file-directory-p (file-name-directory - auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote (file-name-nondirectory - auto-save-list-file-prefix))) - t) - (insert "\n\nIf an Emacs session crashed recently, " - "type Meta-x recover-session RET\nto recover" - " the files you were editing.")) + ;; The rest of the startup screen is the same on all + ;; kinds of terminals. + + ;; Give information on recovering, if there was a crash. + (and auto-save-list-file-prefix + ;; Don't signal an error if the + ;; directory for auto-save-list files + ;; does not yet exist. + (file-directory-p (file-name-directory + auto-save-list-file-prefix)) + (directory-files + (file-name-directory auto-save-list-file-prefix) + nil + (concat "\\`" + (regexp-quote (file-name-nondirectory + auto-save-list-file-prefix))) + t) + (insert "\n\nIf an Emacs session crashed recently, " - "type M-x recover-session RET\nto recover" ++ "type Meta-x recover-session RET\nto recover" + " the files you were editing.")) ;; Display the input that we set up in the buffer. (set-buffer-modified-p nil) + (setq buffer-read-only t) + (if (and view-read-only (not view-mode)) + (view-mode-enter nil 'kill-buffer)) (goto-char (point-min)) - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - ;; If hide-on-input is nil, creating a new frame will - ;; generate enough events that the subsequent `sit-for' - ;; will immediately return anyway. - (pop-to-buffer (current-buffer)) - (if hide-on-input - (if hide-on-input - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - ;; If hide-on-input is nil, creating a new frame will - ;; generate enough events that the subsequent `sit-for' - ;; will immediately return anyway. - nil ;; (pop-to-buffer (current-buffer)) ++ (if hide-on-input ++ (if (or (window-minibuffer-p) ++ (window-dedicated-p (selected-window))) ++ ;; If hide-on-input is nil, creating a new frame will ++ ;; generate enough events that the subsequent `sit-for' ++ ;; will immediately return anyway. ++ nil ;; (pop-to-buffer (current-buffer)) (save-window-excursion - (switch-to-buffer (current-buffer)) - (sit-for 120))) - (condition-case nil - (switch-to-buffer (current-buffer)) - ;; In case the window is dedicated or something. - (error (pop-to-buffer (current-buffer)))))) + (switch-to-buffer (current-buffer)) + (sit-for 120)) - (switch-to-buffer (current-buffer))))) ++ (condition-case nil ++ (switch-to-buffer (current-buffer)))))) ;; Unwind ... ensure splash buffer is killed (if hide-on-input - (kill-buffer "GNU Emacs"))))) + (kill-buffer "GNU Emacs") + (switch-to-buffer "GNU Emacs") + (rename-buffer "*About GNU Emacs*" t))))) (defun startup-echo-area-message () @@@ -1651,16 -1626,54 +1665,17 @@@ (defun display-splash-screen (&optional hide-on-input) "Display splash screen according to display. Fancy splash screens are used on graphic displays, - normal otherwise." - (interactive) + normal otherwise. + With a prefix argument, any user input hides the splash screen." + (interactive "P") - (if (use-fancy-splash-screens-p) - (fancy-splash-screens hide-on-input) - (normal-splash-screen hide-on-input))) - + ;; Prevent recursive calls from server-process-filter. + (if (not (get-buffer "GNU Emacs")) + (if (use-fancy-splash-screens-p) + (fancy-splash-screens hide-on-input) + (normal-splash-screen hide-on-input)))) (defun command-line-1 (command-line-args-left) - (or noninteractive (input-pending-p) init-file-had-error - ;; t if the init file says to inhibit the echo area startup message. - (and inhibit-startup-echo-area-message - user-init-file - (or (and (get 'inhibit-startup-echo-area-message 'saved-value) - (equal inhibit-startup-echo-area-message - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - ;; Wasn't set with custom; see if .emacs has a setq. - (let ((buffer (get-buffer-create " *temp*"))) - (prog1 - (condition-case nil - (save-excursion - (set-buffer buffer) - (insert-file-contents user-init-file) - (re-search-forward - (concat - "([ \t\n]*setq[ \t\n]+" - "inhibit-startup-echo-area-message[ \t\n]+" - (regexp-quote - (prin1-to-string - (if (equal init-file-user "") - (user-login-name) - init-file-user))) - "[ \t\n]*)") - nil t)) - (error nil)) - (kill-buffer buffer))))) - ;; display-splash-screen at the end of command-line-1 calls - ;; use-fancy-splash-screens-p. This can cause image.el to be - ;; loaded, putting "Loading image... done" in the echo area. - ;; This hides startup-echo-area-message. So - ;; use-fancy-splash-screens-p is called here simply to get the - ;; loading of image.el (if needed) out of the way before - ;; display-startup-echo-area-message runs. - (progn - (use-fancy-splash-screens-p) - (display-startup-echo-area-message))) + (display-startup-echo-area-message) ;; Delay 2 seconds after an init file error message ;; was displayed, so user can read it. diff --cc lisp/term/x-win.el index fe774a4125f,8123d509f1c..967d9918b59 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@@ -2384,17 -2375,103 +2384,23 @@@ 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. - (if (assq 'height parsed) - (setq default-frame-alist - (cons (cons 'height (cdr (assq 'height parsed))) - default-frame-alist))) - (if (assq 'width parsed) - (setq default-frame-alist - (cons (cons 'width (cdr (assq 'width parsed))) - default-frame-alist)))))) - -;; Check the reverseVideo resource. -(let ((case-fold-search t)) - (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) - (if (and rv - (string-match "^\\(true\\|yes\\|on\\)$" rv)) - (setq default-frame-alist - (cons '(reverse . t) default-frame-alist))))) +(defun x-clipboard-yank () + "Insert the clipboard contents, or the last stretch of killed text." + (interactive "*") + (let ((clipboard-text (x-selection-value 'CLIPBOARD)) + (x-select-enable-clipboard t)) + (if (and clipboard-text (> (length clipboard-text) 0)) + (kill-new clipboard-text)) + (yank))) + ++(defun x-menu-bar-open (&optional frame) ++ "Open the menu bar if `menu-bar-mode' is on. otherwise call `tmm-menubar'." ++ (interactive "i") ++ (if menu-bar-mode (menu-bar-open frame) ++ (tmm-menubar))) + -;; 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)))) + +;;; Window system initialization. (defun x-win-suspend-error () (error "Suspending an Emacs running under X makes no sense")) diff --cc lisp/term/xterm.el index 2e498a8de86,018841fe168..e574c34543f --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@@ -27,210 -27,6 +27,280 @@@ ;;; 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[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]) + +;; 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;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~" [(C-\?)]) + - (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;44~" [?\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;92~" [?\C-\\]) - - (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)]) ++;; 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~" [(C-M-\?)]) ++ ++(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;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~" [(C-M-\?)]) ++ ++(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 diff --cc src/Makefile.in index cb9db5614a1,af4cb816e18..71eaeadb6ba --- a/src/Makefile.in +++ b/src/Makefile.in @@@ -1149,10 -1143,11 +1149,11 @@@ insdel.o: insdel.c window.h buffer.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 $(config_h) + atimer.h systime.h puresize.h charset.h intervals.h keymap.h window.h \ + $(config_h) lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h \ dispextern.h $(config_h) diff --cc src/frame.c index 021e9bf604f,0b835ffd3b9..d7c58fd8faa --- a/src/frame.c +++ b/src/frame.c @@@ -115,8 -109,10 +115,9 @@@ Lisp_Object Qenvironment Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth; + Lisp_Object Qinhibit_face_set_after_frame_default; Lisp_Object Qface_set_after_frame_default; - Lisp_Object Vterminal_frame; Lisp_Object Vdefault_frame_alist; Lisp_Object Vdefault_frame_scroll_bars; @@@ -3048,8 -2750,10 +3057,9 @@@ x_set_frame_parameters (f, alist if (NATNUMP (param_index) && (XFASTINT (param_index) < sizeof (frame_parms)/sizeof (frame_parms[0])) - && rif->frame_parm_handlers[XINT (param_index)]) - (*(rif->frame_parm_handlers[XINT (param_index)])) (f, val, old_value); - + && FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)]) + (*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value); + unbind_to (count, Qnil); } } } diff --cc src/xmenu.c index 1650222ae84,d049fb99c66..b615d321cc7 --- a/src/xmenu.c +++ b/src/xmenu.c @@@ -1310,7 -1305,7 +1314,7 @@@ popup_get_selection (initial_event, dpy } } - DEFUN ("x-menu-bar-open", Fx_menu_bar_open, Sx_menu_bar_open, 0, 1, "i", -DEFUN ("menu-bar-open", Fmenu_bar_open, Smenu_bar_open, 0, 1, "i", ++DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i", doc: /* Start key navigation of the menu bar in FRAME. This initially opens 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 @@@ -1389,7 -1384,7 +1393,7 @@@ If FRAME is nil or not given, use the s #ifdef USE_GTK - DEFUN ("x-menu-bar-open", Fx_menu_bar_open, Sx_menu_bar_open, 0, 1, "i", -DEFUN ("menu-bar-open", Fmenu_bar_open, Smenu_bar_open, 0, 1, "i", ++DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i", doc: /* Start key navigation of the menu bar in FRAME. This initially opens 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 @@@ -3816,10 -3775,8 +3820,9 @@@ syms_of_xmenu ( defsubr (&Sx_popup_menu); #if defined (USE_GTK) || defined (USE_X_TOOLKIT) - defsubr (&Sx_menu_bar_open); - Fdefalias (intern ("accelerate-menu"), - intern (Sx_menu_bar_open.symbol_name), - Qnil); - defsubr (&Smenu_bar_open); - Ffset (intern ("accelerate-menu"), intern (Smenu_bar_open.symbol_name)); ++ defsubr (&Sx_menu_bar_open_internal); ++ Ffset (intern ("accelerate-menu"), ++ intern (Sx_menu_bar_open_internal.symbol_name)); #endif #ifdef HAVE_MENUS diff --cc src/xterm.c index 466037c75a2,574e8eb4f15..95b2a87fd4b --- a/src/xterm.c +++ b/src/xterm.c @@@ -10899,124 -10866,39 +10938,124 @@@ x_activate_timeout_atimer ( extern frame_parm_handler x_frame_parm_handlers[]; static struct redisplay_interface x_redisplay_interface = -{ - x_frame_parm_handlers, - x_produce_glyphs, - x_write_glyphs, - x_insert_glyphs, - x_clear_end_of_line, - x_scroll_run, - x_after_update_window_line, - x_update_window_begin, - x_update_window_end, - x_cursor_to, - x_flush, + { + x_frame_parm_handlers, + x_produce_glyphs, + x_write_glyphs, + x_insert_glyphs, + x_clear_end_of_line, + x_scroll_run, + x_after_update_window_line, + x_update_window_begin, + x_update_window_end, + x_cursor_to, + x_flush, #ifdef XFlush - x_flush, + x_flush, #else - 0, /* flush_display_optional */ -#endif - x_clear_window_mouse_face, - x_get_glyph_overhangs, - x_fix_overlapping_area, - x_draw_fringe_bitmap, - 0, /* define_fringe_bitmap */ - 0, /* destroy_fringe_bitmap */ - x_per_char_metric, - x_encode_char, - x_compute_glyph_string_overhangs, - x_draw_glyph_string, - x_define_frame_cursor, - x_clear_frame_area, - x_draw_window_cursor, - x_draw_vertical_window_border, - x_shift_glyphs_for_insert -}; + 0, /* flush_display_optional */ +#endif + x_clear_window_mouse_face, + x_get_glyph_overhangs, + x_fix_overlapping_area, + x_draw_fringe_bitmap, + 0, /* define_fringe_bitmap */ + 0, /* destroy_fringe_bitmap */ + x_per_char_metric, + x_encode_char, + x_compute_glyph_string_overhangs, + x_draw_glyph_string, + x_define_frame_cursor, + x_clear_frame_area, + x_draw_window_cursor, + x_draw_vertical_window_border, + x_shift_glyphs_for_insert + }; + + +/* This function is called when the last frame on a display is deleted. */ +void +x_delete_terminal (struct terminal *terminal) +{ + struct x_display_info *dpyinfo = terminal->display_info.x; + int i; + + /* Protect against recursive calls. Fdelete_frame in + delete_terminal calls us back when it deletes our last frame. */ + if (terminal->deleted) + return; + + BLOCK_INPUT; + /* Free the fonts in the font table. */ + for (i = 0; i < dpyinfo->n_fonts; i++) + if (dpyinfo->font_table[i].name) + { + XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font); + } + + x_destroy_all_bitmaps (dpyinfo); + XSetCloseDownMode (dpyinfo->display, DestroyAll); + - #ifdef USE_X_TOOLKIT - XtCloseDisplay (dpyinfo->display); - #else +#ifdef USE_GTK + xg_display_close (dpyinfo->display); ++#else ++#ifdef USE_X_TOOLKIT ++ XtCloseDisplay (dpyinfo->display); +#else + XCloseDisplay (dpyinfo->display); +#endif - #endif ++#endif /* ! USE_GTK */ + + x_delete_display (dpyinfo); + UNBLOCK_INPUT; +} + + +static struct terminal * +x_create_terminal (struct x_display_info *dpyinfo) +{ + struct terminal *terminal; + + terminal = create_terminal (); + + terminal->type = output_x_window; + terminal->display_info.x = dpyinfo; + dpyinfo->terminal = terminal; + + /* kboard is initialized in x_term_init. */ + + terminal->clear_frame_hook = x_clear_frame; + terminal->ins_del_lines_hook = x_ins_del_lines; + terminal->delete_glyphs_hook = x_delete_glyphs; + terminal->ring_bell_hook = XTring_bell; + terminal->reset_terminal_modes_hook = XTreset_terminal_modes; + terminal->set_terminal_modes_hook = XTset_terminal_modes; + terminal->update_begin_hook = x_update_begin; + terminal->update_end_hook = x_update_end; + terminal->set_terminal_window_hook = XTset_terminal_window; + terminal->read_socket_hook = XTread_socket; + terminal->frame_up_to_date_hook = XTframe_up_to_date; + terminal->mouse_position_hook = XTmouse_position; + terminal->frame_rehighlight_hook = XTframe_rehighlight; + terminal->frame_raise_lower_hook = XTframe_raise_lower; + terminal->set_vertical_scroll_bar_hook = XTset_vertical_scroll_bar; + terminal->condemn_scroll_bars_hook = XTcondemn_scroll_bars; + terminal->redeem_scroll_bar_hook = XTredeem_scroll_bar; + terminal->judge_scroll_bars_hook = XTjudge_scroll_bars; + + terminal->delete_frame_hook = x_destroy_window; + terminal->delete_terminal_hook = x_delete_terminal; + + terminal->rif = &x_redisplay_interface; + terminal->scroll_region_ok = 1; /* We'll scroll partial frames. */ + terminal->char_ins_del_ok = 1; + terminal->line_ins_del_ok = 1; /* We'll just blt 'em. */ + terminal->fast_clear_end_of_line = 1; /* X does this well. */ + terminal->memory_below_frame = 0; /* We don't remember what scrolls + off the bottom. */ + + return terminal; +} void x_initialize ()