diff options
| author | Andreas Schwab | 2012-03-11 18:54:16 +0100 |
|---|---|---|
| committer | Andreas Schwab | 2012-03-11 18:54:16 +0100 |
| commit | ad0bf5b6db5b1d8ea654f62675b2484111594ffc (patch) | |
| tree | 70850bfe243cb6484d25e074de2368ee94f98654 | |
| parent | e29ab36b489e14bda49a2c0e61dac3a7e13e75f1 (diff) | |
| download | emacs-ad0bf5b6db5b1d8ea654f62675b2484111594ffc.tar.gz emacs-ad0bf5b6db5b1d8ea654f62675b2484111594ffc.zip | |
* server.el (server-eval-at): Handle non-tcp connections. Decode
result string.
| -rw-r--r-- | lisp/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/server.el | 62 |
2 files changed, 37 insertions, 28 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index abb3872d1ac..0e2a791f0e9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,8 @@ | |||
| 1 | 2012-03-11 Andreas Schwab <schwab@linux-m68k.org> | 1 | 2012-03-11 Andreas Schwab <schwab@linux-m68k.org> |
| 2 | 2 | ||
| 3 | * server.el (server-eval-at): Handle non-tcp connections. Decode | ||
| 4 | result string. | ||
| 5 | |||
| 3 | * server.el (server-msg-size): New constant. | 6 | * server.el (server-msg-size): New constant. |
| 4 | (server-reply-print): New function. | 7 | (server-reply-print): New function. |
| 5 | (server-eval-and-print): Use it. | 8 | (server-eval-and-print): Use it. |
diff --git a/lisp/server.el b/lisp/server.el index 78b81e0b05b..ed83225eccd 100644 --- a/lisp/server.el +++ b/lisp/server.el | |||
| @@ -1559,34 +1559,39 @@ only these files will be asked to be saved." | |||
| 1559 | Returns the result of the evaluation, or signals an error if it | 1559 | Returns the result of the evaluation, or signals an error if it |
| 1560 | cannot contact the specified server. For example: | 1560 | cannot contact the specified server. For example: |
| 1561 | \(server-eval-at \"server\" '(emacs-pid)) | 1561 | \(server-eval-at \"server\" '(emacs-pid)) |
| 1562 | returns the process ID of the Emacs instance running \"server\". | 1562 | returns the process ID of the Emacs instance running \"server\"." |
| 1563 | This function requires the use of TCP sockets. " | 1563 | (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir)) |
| 1564 | (or server-use-tcp | 1564 | (server-file (expand-file-name server server-dir)) |
| 1565 | (error "This function requires TCP sockets")) | 1565 | (coding-system-for-read 'binary) |
| 1566 | (let ((auth-file (expand-file-name server server-auth-dir)) | 1566 | (coding-system-for-write 'binary) |
| 1567 | (coding-system-for-read 'binary) | 1567 | address port secret process) |
| 1568 | (coding-system-for-write 'binary) | 1568 | (unless (file-exists-p server-file) |
| 1569 | address port secret process) | 1569 | (error "No such server: %s" server)) |
| 1570 | (unless (file-exists-p auth-file) | ||
| 1571 | (error "No such server definition: %s" auth-file)) | ||
| 1572 | (with-temp-buffer | 1570 | (with-temp-buffer |
| 1573 | (insert-file-contents auth-file) | 1571 | (when server-use-tcp |
| 1574 | (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)") | 1572 | (let ((coding-system-for-read 'no-conversion)) |
| 1575 | (error "Invalid auth file")) | 1573 | (insert-file-contents server-file) |
| 1576 | (setq address (match-string 1) | 1574 | (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)") |
| 1577 | port (string-to-number (match-string 2))) | 1575 | (error "Invalid auth file")) |
| 1578 | (forward-line 1) | 1576 | (setq address (match-string 1) |
| 1579 | (setq secret (buffer-substring (point) (line-end-position))) | 1577 | port (string-to-number (match-string 2))) |
| 1580 | (erase-buffer) | 1578 | (forward-line 1) |
| 1581 | (unless (setq process (open-network-stream "eval-at" (current-buffer) | 1579 | (setq secret (buffer-substring (point) (line-end-position))) |
| 1582 | address port)) | 1580 | (erase-buffer))) |
| 1583 | (error "Unable to contact the server")) | 1581 | (unless (setq process (make-network-process |
| 1584 | (set-process-query-on-exit-flag process nil) | 1582 | :name "eval-at" |
| 1585 | (process-send-string | 1583 | :buffer (current-buffer) |
| 1586 | process | 1584 | :host address |
| 1587 | (concat "-auth " secret " -eval " | 1585 | :service (if server-use-tcp port server-file) |
| 1588 | (server-quote-arg (format "%S" form)) | 1586 | :family (if server-use-tcp 'ipv4 'local) |
| 1589 | "\n")) | 1587 | :noquery t)) |
| 1588 | (error "Unable to contact the server")) | ||
| 1589 | (if server-use-tcp | ||
| 1590 | (process-send-string process (concat "-auth " secret "\n"))) | ||
| 1591 | (process-send-string process | ||
| 1592 | (concat "-eval " | ||
| 1593 | (server-quote-arg (format "%S" form)) | ||
| 1594 | "\n")) | ||
| 1590 | (while (memq (process-status process) '(open run)) | 1595 | (while (memq (process-status process) '(open run)) |
| 1591 | (accept-process-output process 0 10)) | 1596 | (accept-process-output process 0 10)) |
| 1592 | (goto-char (point-min)) | 1597 | (goto-char (point-min)) |
| @@ -1600,7 +1605,8 @@ This function requires the use of TCP sockets. " | |||
| 1600 | (progn (skip-chars-forward "^\n") | 1605 | (progn (skip-chars-forward "^\n") |
| 1601 | (point)))))) | 1606 | (point)))))) |
| 1602 | (if (not (equal answer "")) | 1607 | (if (not (equal answer "")) |
| 1603 | (read (server-unquote-arg answer))))))) | 1608 | (read (decode-coding-string (server-unquote-arg answer) |
| 1609 | 'emacs-internal))))))) | ||
| 1604 | 1610 | ||
| 1605 | 1611 | ||
| 1606 | (provide 'server) | 1612 | (provide 'server) |