Mercurial > emacs
comparison lisp/server.el @ 83009:b2b37c85b00a
Numerous bugfixes and small improvements.
lisp/bindings.el (mode-line-frame-identification): Use %T, not %F.
lisp/faces.el (x-create-frame-with-faces): Added
frame-creation-function parameter.
(tty-create-frame-with-faces): Ditto.
lisp/frame.el (frame-creation-function): Make it frame-local.
(select-frame-set-input-focus): Use the window-system function, not
the variable.
lisp/server.el (server-handle-delete-tty): Make sure the client
process is removed from server-clients after the delete-process call.
It seems that the sentinel is not called. Added docs.
(server-process-filter): Immediately add the client to server-clients
when a new termcap frame is created. Fixed a case of `not' called
with two parameters. Ignore errors while sending the evaluation
result back to the client.
(server-kill-buffer-query-function): Don't ask the user if the server
process is already dead.
lisp/term/x-win.el: Don't change mode-line-frame-identification.
src/buffer.c (syms_of_buffer): Added %T to the docs of mode-line-format.
src/dispnew.c (init_display): Increment the reference count of the new
termcap display.
src/frame.c (make_terminal_frame): Set the old top frame's visibility
to `obscured'.
(Fmake_terminal_frame): Look at the current termcap display's name,
not just the similar frame parameter. Try to get the type from the
current display first, and only then from Vdefault_frame_alist.
src/keyboard.c (handle_interrupt): New function to separate the signal
handling from C-g processing.
(interrupt_signal): Call handle_interrupt to do the real work.
(kbd_buffer_store_event): Use handle_interrupt instead of interrupt_signal.
(cmd_error_internal): Use FRAME_INITIAL_P instead of ugly hacks.
src/termhooks.h (initial_display): New declaration.
src/xdisp.c (decode_mode_spec): Added '%T' (termcap-only frame name).
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-49
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Sat, 10 Jan 2004 12:56:22 +0000 |
parents | 039bd6989d29 |
children | 1d2f73785d9d |
comparison
equal
deleted
inserted
replaced
83008:040dd41ed7d0 | 83009:b2b37c85b00a |
---|---|
210 (when (server-tty-live-p (cadr tty)) | 210 (when (server-tty-live-p (cadr tty)) |
211 (delete-tty (cadr tty))))))) | 211 (delete-tty (cadr tty))))))) |
212 (server-log (format "Status changed to %s" (process-status proc)) proc)) | 212 (server-log (format "Status changed to %s" (process-status proc)) proc)) |
213 | 213 |
214 (defun server-handle-delete-tty (tty) | 214 (defun server-handle-delete-tty (tty) |
215 "Delete the client connection when the emacsclient frame is deleted." | |
215 (dolist (entry server-ttys) | 216 (dolist (entry server-ttys) |
216 (let ((proc (nth 0 entry)) | 217 (let ((proc (nth 0 entry)) |
217 (term (nth 1 entry))) | 218 (term (nth 1 entry))) |
218 (when (equal term tty) | 219 (when (equal term tty) |
219 (let ((client (assq proc server-clients))) | 220 (let ((client (assq proc server-clients))) |
220 (setq server-ttys (delq entry server-ttys)) | 221 (setq server-ttys (delq entry server-ttys)) |
221 (delete-process (car client))))))) | 222 (delete-process (car client)) |
223 (when (assq proc server-clients) | |
224 ;; This seems to be necessary to handle | |
225 ;; `emacsclient -t -e '(delete-frame)'' correctly. | |
226 (setq server-clients (delq client server-clients)))))))) | |
222 | 227 |
223 (defun server-select-display (display) | 228 (defun server-select-display (display) |
224 ;; If the current frame is on `display' we're all set. | 229 ;; If the current frame is on `display' we're all set. |
225 (unless (equal (frame-parameter (selected-frame) 'display) display) | 230 (unless (equal (frame-parameter (selected-frame) 'display) display) |
226 ;; Otherwise, look for an existing frame there and select it. | 231 ;; Otherwise, look for an existing frame there and select it. |
334 (let ((request (substring string 0 (match-beginning 0))) | 339 (let ((request (substring string 0 (match-beginning 0))) |
335 (coding-system (and default-enable-multibyte-characters | 340 (coding-system (and default-enable-multibyte-characters |
336 (or file-name-coding-system | 341 (or file-name-coding-system |
337 default-file-name-coding-system))) | 342 default-file-name-coding-system))) |
338 client nowait eval newframe | 343 client nowait eval newframe |
344 registered ; t if the client is already added to server-clients. | |
339 (files nil) | 345 (files nil) |
340 (lineno 1) | 346 (lineno 1) |
341 (columnno 0)) | 347 (columnno 0)) |
342 ;; Remove this line from STRING. | 348 ;; Remove this line from STRING. |
343 (setq string (substring string (match-end 0))) | 349 (setq string (substring string (match-end 0))) |
361 (type (server-unquote-arg (match-string 2 request)))) | 367 (type (server-unquote-arg (match-string 2 request)))) |
362 (setq request (substring request (match-end 0))) | 368 (setq request (substring request (match-end 0))) |
363 (condition-case err | 369 (condition-case err |
364 (let ((frame (make-frame-on-tty tty type))) | 370 (let ((frame (make-frame-on-tty tty type))) |
365 (setq server-ttys (cons (list (car client) (frame-tty-name frame)) server-ttys)) | 371 (setq server-ttys (cons (list (car client) (frame-tty-name frame)) server-ttys)) |
366 (sit-for 0) | |
367 (process-send-string proc (concat "emacs-pid " (number-to-string (emacs-pid)) "\n")) | 372 (process-send-string proc (concat "emacs-pid " (number-to-string (emacs-pid)) "\n")) |
368 (select-frame frame) | 373 (select-frame frame) |
369 (setq newframe t)) | 374 ;; This makes sure that `emacsclient -t -e '(delete-frame)'' works right. |
370 (error (ignore-errors (process-send-string proc (concat (nth 1 err) "\n"))) | 375 (push client server-clients) |
376 (setq registered t | |
377 newframe t)) | |
378 (error (process-send-string proc (concat (nth 1 err) "\n")) | |
371 (setq request ""))))) | 379 (setq request ""))))) |
372 ;; ARG is a line number option. | 380 ;; ARG is a line number option. |
373 ((string-match "\\`\\+[0-9]+\\'" arg) | 381 ((string-match "\\`\\+[0-9]+\\'" arg) |
374 (setq lineno (string-to-int (substring arg 1)))) | 382 (setq lineno (string-to-int (substring arg 1)))) |
375 ;; ARG is line number:column option. | 383 ;; ARG is line number:column option. |
384 (if coding-system | 392 (if coding-system |
385 (setq arg (decode-coding-string arg coding-system))) | 393 (setq arg (decode-coding-string arg coding-system))) |
386 (if eval | 394 (if eval |
387 (condition-case err | 395 (condition-case err |
388 (let ((v (eval (car (read-from-string arg))))) | 396 (let ((v (eval (car (read-from-string arg))))) |
389 (when (and (not newframe v)) | 397 (when (and (not newframe) v) |
390 (with-temp-buffer | 398 (with-temp-buffer |
391 (let ((standard-output (current-buffer))) | 399 (let ((standard-output (current-buffer))) |
392 (pp v) | 400 (pp v) |
393 (process-send-region proc (point-min) (point-max)))))) | 401 (process-send-region proc (point-min) (point-max)))))) |
394 (error (process-send-string proc (concat "*Error* " (error-message-string err))))) | 402 (error |
403 (ignore-errors | |
404 (process-send-string | |
405 proc (concat "*Error* " (error-message-string err)))))) | |
395 | 406 |
396 ;; ARG is a file name. | 407 ;; ARG is a file name. |
397 ;; Collapse multiple slashes to single slashes. | 408 ;; Collapse multiple slashes to single slashes. |
398 (setq arg (command-line-normalize-file-name arg)) | 409 (setq arg (command-line-normalize-file-name arg)) |
399 (push (list arg lineno columnno) files)) | 410 (push (list arg lineno columnno) files)) |
408 ;; This client is empty; get rid of it immediately. | 419 ;; This client is empty; get rid of it immediately. |
409 (progn | 420 (progn |
410 (delete-process proc) | 421 (delete-process proc) |
411 (server-log "Close empty client" proc)) | 422 (server-log "Close empty client" proc)) |
412 ;; We visited some buffer for this client. | 423 ;; We visited some buffer for this client. |
413 (or nowait (push client server-clients)) | 424 (or nowait registered (push client server-clients)) |
414 (unless (or isearch-mode (minibufferp)) | 425 (unless (or isearch-mode (minibufferp)) |
415 (if (and newframe (null (cdr client))) | 426 (if (and newframe (null (cdr client))) |
416 (message (substitute-command-keys | 427 (message (substitute-command-keys |
417 "When done with this frame, type \\[delete-frame]")) | 428 "When done with this frame, type \\[delete-frame]")) |
418 (server-switch-buffer (nth 1 client)) | 429 (server-switch-buffer (nth 1 client)) |
569 ;; It was suggested to release its client instead, | 580 ;; It was suggested to release its client instead, |
570 ;; but I think that is dangerous--the client would proceed | 581 ;; but I think that is dangerous--the client would proceed |
571 ;; using whatever is on disk in that file. -- rms. | 582 ;; using whatever is on disk in that file. -- rms. |
572 (defun server-kill-buffer-query-function () | 583 (defun server-kill-buffer-query-function () |
573 (or (not server-buffer-clients) | 584 (or (not server-buffer-clients) |
585 (let ((res t)) | |
586 (dolist (proc server-buffer-clients res) | |
587 (setq proc (assq proc server-clients)) | |
588 (when (and proc (eq (process-status (car proc)) 'open)) | |
589 (setq res nil)))) | |
574 (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " | 590 (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " |
575 (buffer-name (current-buffer)))))) | 591 (buffer-name (current-buffer)))))) |
576 | 592 |
577 (add-hook 'kill-buffer-query-functions | 593 (add-hook 'kill-buffer-query-functions |
578 'server-kill-buffer-query-function) | 594 'server-kill-buffer-query-function) |