diff options
| author | Juanma Barranquero | 2006-11-02 01:31:39 +0000 |
|---|---|---|
| committer | Juanma Barranquero | 2006-11-02 01:31:39 +0000 |
| commit | 95eefb35101f1489de82f26366a42a0c3ed2de7a (patch) | |
| tree | 2751bc6dd8f8f65002606fe4f4cdcf75c7f975d0 | |
| parent | 0a81bd34a4d64f9d2b6c9f5d2978b1a4f02b1c6b (diff) | |
| download | emacs-95eefb35101f1489de82f26366a42a0c3ed2de7a.tar.gz emacs-95eefb35101f1489de82f26366a42a0c3ed2de7a.zip | |
(server-visit-files): Use `when'.
(server-process-filter): When authentication fails, send error message to
client. Wrap `process-send-region' in `ignore-errors' instead of
`condition-case', and remove misleading comment.
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/server.el | 121 |
2 files changed, 67 insertions, 63 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d6d3080c900..25e45ee9132 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2006-11-02 Juanma Barranquero <lekktu@gmail.com> | ||
| 2 | |||
| 3 | * server.el (server-visit-files): Use `when'. | ||
| 4 | (server-process-filter): When authentication fails, send error | ||
| 5 | message to client. Wrap `process-send-region' in `ignore-errors' | ||
| 6 | instead of `condition-case', and remove misleading comment. | ||
| 7 | |||
| 1 | 2006-11-01 Juri Linkov <juri@jurta.org> | 8 | 2006-11-01 Juri Linkov <juri@jurta.org> |
| 2 | 9 | ||
| 3 | * simple.el (yank): Doc fix. | 10 | * simple.el (yank): Doc fix. |
| @@ -12,7 +19,7 @@ | |||
| 12 | * battery.el (battery-linux-proc-acpi): Prevent range error when | 19 | * battery.el (battery-linux-proc-acpi): Prevent range error when |
| 13 | `full-capacity' is 0. | 20 | `full-capacity' is 0. |
| 14 | 21 | ||
| 15 | 2006-10-31 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change) | 22 | 2006-10-31 Yoni Rabkin Katzenell <yoni-r@actcom.com> (tiny change) |
| 16 | 23 | ||
| 17 | * lisp/faces.el (faces-sample-overlay): New defvar. | 24 | * lisp/faces.el (faces-sample-overlay): New defvar. |
| 18 | (faces-sample-overlay): New function to show face sample text. | 25 | (faces-sample-overlay): New function to show face sample text. |
diff --git a/lisp/server.el b/lisp/server.el index 50bf6f766ec..7f2962fcc69 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -312,7 +312,7 @@ Prefix arg means just kill any existing server communications subprocess." | |||
| 312 | ;; Delete the socket or authentication files made by previous | 312 | ;; Delete the socket or authentication files made by previous |
| 313 | ;; server invocations. | 313 | ;; server invocations. |
| 314 | (if (eq (process-contact server-process :family) 'local) | 314 | (if (eq (process-contact server-process :family) 'local) |
| 315 | (delete-file (expand-file-name server-name server-socket-dir)) | 315 | (delete-file (expand-file-name server-name server-socket-dir)) |
| 316 | (setq server-auth-key nil) | 316 | (setq server-auth-key nil) |
| 317 | (delete-file (expand-file-name server-name server-auth-dir))))) | 317 | (delete-file (expand-file-name server-name server-auth-dir))))) |
| 318 | ;; If this Emacs already had a server, clear out associated status. | 318 | ;; If this Emacs already had a server, clear out associated status. |
| @@ -325,7 +325,7 @@ Prefix arg means just kill any existing server communications subprocess." | |||
| 325 | (server-ensure-safe-dir | 325 | (server-ensure-safe-dir |
| 326 | (if server-use-tcp server-auth-dir server-socket-dir)) | 326 | (if server-use-tcp server-auth-dir server-socket-dir)) |
| 327 | (when server-process | 327 | (when server-process |
| 328 | (server-log (message "Restarting server"))) | 328 | (server-log (message "Restarting server"))) |
| 329 | (letf (((default-file-modes) ?\700)) | 329 | (letf (((default-file-modes) ?\700)) |
| 330 | (setq server-process | 330 | (setq server-process |
| 331 | (apply #'make-network-process | 331 | (apply #'make-network-process |
| @@ -388,6 +388,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." | |||
| 388 | (process-put proc :authenticated t) | 388 | (process-put proc :authenticated t) |
| 389 | (server-log "Authentication successful" proc)) | 389 | (server-log "Authentication successful" proc)) |
| 390 | (server-log "Authentication failed" proc) | 390 | (server-log "Authentication failed" proc) |
| 391 | (process-send-string proc "Authentication failed") | ||
| 391 | (delete-process proc) | 392 | (delete-process proc) |
| 392 | ;; We return immediately | 393 | ;; We return immediately |
| 393 | (return-from server-process-filter))) | 394 | (return-from server-process-filter))) |
| @@ -415,52 +416,48 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." | |||
| 415 | (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) | 416 | (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))) |
| 416 | (setq request (substring request (match-end 0))) | 417 | (setq request (substring request (match-end 0))) |
| 417 | (cond | 418 | (cond |
| 418 | ((equal "-nowait" arg) (setq nowait t)) | 419 | ((equal "-nowait" arg) (setq nowait t)) |
| 419 | ((equal "-eval" arg) (setq eval t)) | 420 | ((equal "-eval" arg) (setq eval t)) |
| 420 | ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) | 421 | ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request)) |
| 421 | (let ((display (server-unquote-arg (match-string 1 request)))) | 422 | (let ((display (server-unquote-arg (match-string 1 request)))) |
| 422 | (setq request (substring request (match-end 0))) | 423 | (setq request (substring request (match-end 0))) |
| 423 | (condition-case err | 424 | (condition-case err |
| 424 | (setq tmp-frame (server-select-display display)) | 425 | (setq tmp-frame (server-select-display display)) |
| 425 | (error (process-send-string proc (nth 1 err)) | 426 | (error (process-send-string proc (nth 1 err)) |
| 426 | (setq request ""))))) | 427 | (setq request ""))))) |
| 427 | ;; ARG is a line number option. | 428 | ;; ARG is a line number option. |
| 428 | ((string-match "\\`\\+[0-9]+\\'" arg) | 429 | ((string-match "\\`\\+[0-9]+\\'" arg) |
| 429 | (setq lineno (string-to-number (substring arg 1)))) | 430 | (setq lineno (string-to-number (substring arg 1)))) |
| 430 | ;; ARG is line number:column option. | 431 | ;; ARG is line number:column option. |
| 431 | ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) | 432 | ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg) |
| 432 | (setq lineno (string-to-number (match-string 1 arg)) | 433 | (setq lineno (string-to-number (match-string 1 arg)) |
| 433 | columnno (string-to-number (match-string 2 arg)))) | 434 | columnno (string-to-number (match-string 2 arg)))) |
| 434 | (t | 435 | (t |
| 435 | ;; Undo the quoting that emacsclient does | 436 | ;; Undo the quoting that emacsclient does |
| 436 | ;; for certain special characters. | 437 | ;; for certain special characters. |
| 437 | (setq arg (server-unquote-arg arg)) | 438 | (setq arg (server-unquote-arg arg)) |
| 438 | ;; Now decode the file name if necessary. | 439 | ;; Now decode the file name if necessary. |
| 439 | (when coding-system | 440 | (when coding-system |
| 440 | (setq arg (decode-coding-string arg coding-system))) | 441 | (setq arg (decode-coding-string arg coding-system))) |
| 441 | (if eval | 442 | (if eval |
| 442 | (let* (errorp | 443 | (let* (errorp |
| 443 | (v (condition-case errobj | 444 | (v (condition-case errobj |
| 444 | (eval (car (read-from-string arg))) | 445 | (eval (car (read-from-string arg))) |
| 445 | (error (setq errorp t) errobj)))) | 446 | (error (setq errorp t) errobj)))) |
| 446 | (when v | 447 | (when v |
| 447 | (with-temp-buffer | 448 | (with-temp-buffer |
| 448 | (let ((standard-output (current-buffer))) | 449 | (let ((standard-output (current-buffer))) |
| 449 | (if errorp (princ "error: ")) | 450 | (when errorp (princ "error: ")) |
| 450 | (pp v) | 451 | (pp v) |
| 451 | ;; Suppress the error signalled when the pipe to | 452 | (ignore-errors |
| 452 | ;; PROC is closed. | 453 | (process-send-region proc (point-min) (point-max))) |
| 453 | (condition-case err | 454 | )))) |
| 454 | (process-send-region proc (point-min) (point-max)) | 455 | ;; ARG is a file name. |
| 455 | (file-error nil) | 456 | ;; Collapse multiple slashes to single slashes. |
| 456 | (error nil)) | 457 | (setq arg (command-line-normalize-file-name arg)) |
| 457 | )))) | 458 | (push (list arg lineno columnno) files)) |
| 458 | ;; ARG is a file name. | 459 | (setq lineno 1) |
| 459 | ;; Collapse multiple slashes to single slashes. | 460 | (setq columnno 0))))) |
| 460 | (setq arg (command-line-normalize-file-name arg)) | ||
| 461 | (push (list arg lineno columnno) files)) | ||
| 462 | (setq lineno 1) | ||
| 463 | (setq columnno 0))))) | ||
| 464 | (when files | 461 | (when files |
| 465 | (run-hooks 'pre-command-hook) | 462 | (run-hooks 'pre-command-hook) |
| 466 | (server-visit-files files client nowait) | 463 | (server-visit-files files client nowait) |
| @@ -478,7 +475,7 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"." | |||
| 478 | (run-hooks 'server-switch-hook) | 475 | (run-hooks 'server-switch-hook) |
| 479 | (unless nowait | 476 | (unless nowait |
| 480 | (message "%s" (substitute-command-keys | 477 | (message "%s" (substitute-command-keys |
| 481 | "When done with a buffer, type \\[server-edit]"))))) | 478 | "When done with a buffer, type \\[server-edit]"))))) |
| 482 | (when (frame-live-p tmp-frame) | 479 | (when (frame-live-p tmp-frame) |
| 483 | ;; Delete tmp-frame or make it visible depending on whether it's | 480 | ;; Delete tmp-frame or make it visible depending on whether it's |
| 484 | ;; been used or not. | 481 | ;; been used or not. |
| @@ -514,14 +511,14 @@ so don't mark these buffers specially, just visit them normally." | |||
| 514 | (if (and obuf (set-buffer obuf)) | 511 | (if (and obuf (set-buffer obuf)) |
| 515 | (progn | 512 | (progn |
| 516 | (cond ((file-exists-p filen) | 513 | (cond ((file-exists-p filen) |
| 517 | (if (not (verify-visited-file-modtime obuf)) | 514 | (when (not (verify-visited-file-modtime obuf)) |
| 518 | (revert-buffer t nil))) | 515 | (revert-buffer t nil))) |
| 519 | (t | 516 | (t |
| 520 | (if (y-or-n-p | 517 | (when (y-or-n-p |
| 521 | (concat "File no longer exists: " | 518 | (concat "File no longer exists: " |
| 522 | filen | 519 | filen |
| 523 | ", write buffer to file? ")) | 520 | ", write buffer to file? ")) |
| 524 | (write-file filen)))) | 521 | (write-file filen)))) |
| 525 | (setq server-existing-buffer t) | 522 | (setq server-existing-buffer t) |
| 526 | (server-goto-line-column file)) | 523 | (server-goto-line-column file)) |
| 527 | (set-buffer (find-file-noselect filen)) | 524 | (set-buffer (find-file-noselect filen)) |
| @@ -675,12 +672,12 @@ If invoked with a prefix argument, or if there is no server process running, | |||
| 675 | starts server process and that is all. Invoked by \\[server-edit]." | 672 | starts server process and that is all. Invoked by \\[server-edit]." |
| 676 | (interactive "P") | 673 | (interactive "P") |
| 677 | (cond | 674 | (cond |
| 678 | ((or arg | 675 | ((or arg |
| 679 | (not server-process) | 676 | (not server-process) |
| 680 | (memq (process-status server-process) '(signal exit))) | 677 | (memq (process-status server-process) '(signal exit))) |
| 681 | (server-mode 1)) | 678 | (server-mode 1)) |
| 682 | (server-clients (apply 'server-switch-buffer (server-done))) | 679 | (server-clients (apply 'server-switch-buffer (server-done))) |
| 683 | (t (message "No server editing buffers exist")))) | 680 | (t (message "No server editing buffers exist")))) |
| 684 | 681 | ||
| 685 | (defun server-switch-buffer (&optional next-buffer killed-one) | 682 | (defun server-switch-buffer (&optional next-buffer killed-one) |
| 686 | "Switch to another buffer, preferably one that has a client. | 683 | "Switch to another buffer, preferably one that has a client. |