Commit 59003be9 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/server.el (server-process-filter): Use pcase.

parent 9517f8af
2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca> 2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca>
   
* server.el (server-process-filter): Use pcase.
* emacs-lisp/smie.el (smie-blink-matching-open): Don't use `pos' in two * emacs-lisp/smie.el (smie-blink-matching-open): Don't use `pos' in two
conflicting ways. conflicting ways.
(smie-indent--parent): Extend to "parent of arg". (smie-indent--parent): Extend to "parent of arg".
......
...@@ -937,43 +937,41 @@ The following commands are accepted by the client: ...@@ -937,43 +937,41 @@ The following commands are accepted by the client:
tty-type ; string. tty-type ; string.
files files
filepos filepos
command-line-args-left args-left)
arg)
;; Remove this line from STRING. ;; Remove this line from STRING.
(setq string (substring string (match-end 0))) (setq string (substring string (match-end 0)))
(setq command-line-args-left (setq args-left
(mapcar 'server-unquote-arg (split-string request " " t))) (mapcar 'server-unquote-arg (split-string request " " t)))
(while (setq arg (pop command-line-args-left)) (while args-left
(cond (pcase (pop args-left)
;; -version CLIENT-VERSION: obsolete at birth. ;; -version CLIENT-VERSION: obsolete at birth.
((and (equal "-version" arg) command-line-args-left) (`"-version" (pop args-left))
(pop command-line-args-left))
;; -nowait: Emacsclient won't wait for a result. ;; -nowait: Emacsclient won't wait for a result.
((equal "-nowait" arg) (setq nowait t)) (`"-nowait" (setq nowait t))
;; -current-frame: Don't create frames. ;; -current-frame: Don't create frames.
((equal "-current-frame" arg) (setq use-current-frame t)) (`"-current-frame" (setq use-current-frame t))
;; -display DISPLAY: ;; -display DISPLAY:
;; Open X frames on the given display instead of the default. ;; Open X frames on the given display instead of the default.
((and (equal "-display" arg) command-line-args-left) (`"-display"
(setq display (pop command-line-args-left)) (setq display (pop args-left))
(if (zerop (length display)) (setq display nil))) (if (zerop (length display)) (setq display nil)))
;; -parent-id ID: ;; -parent-id ID:
;; Open X frame within window ID, via XEmbed. ;; Open X frame within window ID, via XEmbed.
((and (equal "-parent-id" arg) command-line-args-left) (`"-parent-id"
(setq parent-id (pop command-line-args-left)) (setq parent-id (pop args-left))
(if (zerop (length parent-id)) (setq parent-id nil))) (if (zerop (length parent-id)) (setq parent-id nil)))
;; -window-system: Open a new X frame. ;; -window-system: Open a new X frame.
((equal "-window-system" arg) (`"-window-system"
(setq dontkill t) (setq dontkill t)
(setq tty-name 'window-system)) (setq tty-name 'window-system))
;; -resume: Resume a suspended tty frame. ;; -resume: Resume a suspended tty frame.
((equal "-resume" arg) (`"-resume"
(lexical-let ((terminal (process-get proc 'terminal))) (lexical-let ((terminal (process-get proc 'terminal)))
(setq dontkill t) (setq dontkill t)
(push (lambda () (push (lambda ()
...@@ -984,7 +982,7 @@ The following commands are accepted by the client: ...@@ -984,7 +982,7 @@ The following commands are accepted by the client:
;; -suspend: Suspend the client's frame. (In case we ;; -suspend: Suspend the client's frame. (In case we
;; get out of sync, and a C-z sends a SIGTSTP to ;; get out of sync, and a C-z sends a SIGTSTP to
;; emacsclient.) ;; emacsclient.)
((equal "-suspend" arg) (`"-suspend"
(lexical-let ((terminal (process-get proc 'terminal))) (lexical-let ((terminal (process-get proc 'terminal)))
(setq dontkill t) (setq dontkill t)
(push (lambda () (push (lambda ()
...@@ -994,33 +992,32 @@ The following commands are accepted by the client: ...@@ -994,33 +992,32 @@ The following commands are accepted by the client:
;; -ignore COMMENT: Noop; useful for debugging emacsclient. ;; -ignore COMMENT: Noop; useful for debugging emacsclient.
;; (The given comment appears in the server log.) ;; (The given comment appears in the server log.)
((and (equal "-ignore" arg) command-line-args-left (`"-ignore"
(setq dontkill t) (setq dontkill t)
(pop command-line-args-left))) (pop args-left))
;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client.
((and (equal "-tty" arg) (`"-tty"
(cdr command-line-args-left)) (setq tty-name (pop args-left)
(setq tty-name (pop command-line-args-left) tty-type (pop args-left)
tty-type (pop command-line-args-left)
dontkill (or dontkill dontkill (or dontkill
(not use-current-frame)))) (not use-current-frame))))
;; -position LINE[:COLUMN]: Set point to the given ;; -position LINE[:COLUMN]: Set point to the given
;; position in the next file. ;; position in the next file.
((and (equal "-position" arg) (`"-position"
command-line-args-left (if (not (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
(string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" (car args-left)))
(car command-line-args-left))) (error "Invalid -position command in client args"))
(setq arg (pop command-line-args-left)) (let ((arg (pop args-left)))
(setq filepos (setq filepos
(cons (string-to-number (match-string 1 arg)) (cons (string-to-number (match-string 1 arg))
(string-to-number (or (match-string 2 arg) ""))))) (string-to-number (or (match-string 2 arg)
""))))))
;; -file FILENAME: Load the given file. ;; -file FILENAME: Load the given file.
((and (equal "-file" arg) (`"-file"
command-line-args-left) (let ((file (pop args-left)))
(let ((file (pop command-line-args-left)))
(if coding-system (if coding-system
(setq file (decode-coding-string file coding-system))) (setq file (decode-coding-string file coding-system)))
(setq file (expand-file-name file dir)) (setq file (expand-file-name file dir))
...@@ -1030,11 +1027,10 @@ The following commands are accepted by the client: ...@@ -1030,11 +1027,10 @@ The following commands are accepted by the client:
(setq filepos nil)) (setq filepos nil))
;; -eval EXPR: Evaluate a Lisp expression. ;; -eval EXPR: Evaluate a Lisp expression.
((and (equal "-eval" arg) (`"-eval"
command-line-args-left)
(if use-current-frame (if use-current-frame
(setq use-current-frame 'always)) (setq use-current-frame 'always))
(lexical-let ((expr (pop command-line-args-left))) (lexical-let ((expr (pop args-left)))
(if coding-system (if coding-system
(setq expr (decode-coding-string expr coding-system))) (setq expr (decode-coding-string expr coding-system)))
(push (lambda () (server-eval-and-print expr proc)) (push (lambda () (server-eval-and-print expr proc))
...@@ -1042,21 +1038,21 @@ The following commands are accepted by the client: ...@@ -1042,21 +1038,21 @@ The following commands are accepted by the client:
(setq filepos nil))) (setq filepos nil)))
;; -env NAME=VALUE: An environment variable. ;; -env NAME=VALUE: An environment variable.
((and (equal "-env" arg) command-line-args-left) (`"-env"
(let ((var (pop command-line-args-left))) (let ((var (pop args-left)))
;; XXX Variables should be encoded as in getenv/setenv. ;; XXX Variables should be encoded as in getenv/setenv.
(process-put proc 'env (process-put proc 'env
(cons var (process-get proc 'env))))) (cons var (process-get proc 'env)))))
;; -dir DIRNAME: The cwd of the emacsclient process. ;; -dir DIRNAME: The cwd of the emacsclient process.
((and (equal "-dir" arg) command-line-args-left) (`"-dir"
(setq dir (pop command-line-args-left)) (setq dir (pop args-left))
(if coding-system (if coding-system
(setq dir (decode-coding-string dir coding-system))) (setq dir (decode-coding-string dir coding-system)))
(setq dir (command-line-normalize-file-name dir))) (setq dir (command-line-normalize-file-name dir)))
;; Unknown command. ;; Unknown command.
(t (error "Unknown command: %s" arg)))) (arg (error "Unknown command: %s" arg))))
(setq frame (setq frame
(cond (cond
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment