[Emacs-diffs] /srv/bzr/emacs/trunk r103217: * lisp/server.el (server-process-filter): Use pcase.

[Stefan Monnier]

------------------------------------------------------------
revno: 103217
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2011-02-10 14:41:44 -0500
message:
  * lisp/server.el (server-process-filter): Use pcase.
modified:
  lisp/ChangeLog
  lisp/server.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-02-10 19:40:17 +0000
+++ b/lisp/ChangeLog    2011-02-10 19:41:44 +0000
@@ -1,5 +1,7 @@
 2011-02-10  Stefan Monnier  <address@hidden>
 
+       * server.el (server-process-filter): Use pcase.
+
        * emacs-lisp/smie.el (smie-blink-matching-open): Don't use `pos' in two
        conflicting ways.
        (smie-indent--parent): Extend to "parent of arg".

=== modified file 'lisp/server.el'
--- a/lisp/server.el    2011-01-26 08:36:39 +0000
+++ b/lisp/server.el    2011-02-10 19:41:44 +0000
@@ -937,126 +937,122 @@
                tty-type   ; string.
                files
                filepos
-               command-line-args-left
-               arg)
+               args-left)
            ;; Remove this line from STRING.
            (setq string (substring string (match-end 0)))
-           (setq command-line-args-left
+           (setq args-left
                  (mapcar 'server-unquote-arg (split-string request " " t)))
-           (while (setq arg (pop command-line-args-left))
-               (cond
-                ;; -version CLIENT-VERSION: obsolete at birth.
-                ((and (equal "-version" arg) command-line-args-left)
-                 (pop command-line-args-left))
-
-                ;; -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 use-current-frame t))
-
-                ;; -display DISPLAY:
-                ;; Open X frames on the given display instead of the default.
-                ((and (equal "-display" arg) command-line-args-left)
-                 (setq display (pop command-line-args-left))
-                  (if (zerop (length display)) (setq display nil)))
-
-                ;; -parent-id ID:
-                ;; Open X frame within window ID, via XEmbed.
-                ((and (equal "-parent-id" arg) command-line-args-left)
-                 (setq parent-id (pop command-line-args-left))
-                  (if (zerop (length parent-id)) (setq parent-id nil)))
-
-                ;; -window-system:  Open a new X frame.
-                ((equal "-window-system" arg)
-                  (setq dontkill t)
-                  (setq tty-name 'window-system))
-
-                ;; -resume:  Resume a suspended tty frame.
-                ((equal "-resume" arg)
-                 (lexical-let ((terminal (process-get proc 'terminal)))
-                   (setq dontkill t)
-                    (push (lambda ()
-                            (when (eq (terminal-live-p terminal) t)
-                              (resume-tty terminal)))
-                          commands)))
-
-                ;; -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)
-                 (lexical-let ((terminal (process-get proc 'terminal)))
-                   (setq dontkill t)
-                    (push (lambda ()
-                            (when (eq (terminal-live-p terminal) t)
-                              (suspend-tty terminal)))
-                          commands)))
-
-                ;; -ignore COMMENT:  Noop; useful for debugging emacsclient.
-                ;; (The given comment appears in the server log.)
-                ((and (equal "-ignore" arg) command-line-args-left
-                 (setq dontkill t)
-                 (pop command-line-args-left)))
-
-                ;; -tty DEVICE-NAME TYPE:  Open a new tty frame at the client.
-                ((and (equal "-tty" arg)
-                       (cdr command-line-args-left))
-                  (setq tty-name (pop command-line-args-left)
-                       tty-type (pop command-line-args-left)
-                       dontkill (or dontkill
-                                    (not use-current-frame))))
-
-                ;; -position LINE[:COLUMN]:  Set point to the given
-                ;;  position in the next file.
-                ((and (equal "-position" arg)
-                      command-line-args-left
-                       (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
-                                     (car command-line-args-left)))
-                 (setq arg (pop command-line-args-left))
-                 (setq filepos
-                        (cons (string-to-number (match-string 1 arg))
-                              (string-to-number (or (match-string 2 arg) 
"")))))
-
-                ;; -file FILENAME:  Load the given file.
-                ((and (equal "-file" arg)
-                      command-line-args-left)
-                 (let ((file (pop command-line-args-left)))
-                   (if coding-system
-                       (setq file (decode-coding-string file coding-system)))
-                    (setq file (expand-file-name file dir))
-                   (push (cons file filepos) files)
-                   (server-log (format "New file: %s %s"
-                                        file (or filepos "")) proc))
-                 (setq filepos nil))
-
-                ;; -eval EXPR:  Evaluate a Lisp expression.
-                ((and (equal "-eval" arg)
-                       command-line-args-left)
-                 (if use-current-frame
-                     (setq use-current-frame 'always))
-                 (lexical-let ((expr (pop command-line-args-left)))
-                   (if coding-system
-                       (setq expr (decode-coding-string expr coding-system)))
-                    (push (lambda () (server-eval-and-print expr proc))
-                          commands)
-                   (setq filepos nil)))
-
-                ;; -env NAME=VALUE:  An environment variable.
-                ((and (equal "-env" arg) command-line-args-left)
-                 (let ((var (pop command-line-args-left)))
-                   ;; XXX Variables should be encoded as in getenv/setenv.
-                    (process-put proc 'env
-                                 (cons var (process-get proc 'env)))))
-
-                ;; -dir DIRNAME:  The cwd of the emacsclient process.
-                ((and (equal "-dir" arg) command-line-args-left)
-                 (setq dir (pop command-line-args-left))
-                 (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))))
+           (while args-left
+              (pcase (pop args-left)
+                ;; -version CLIENT-VERSION: obsolete at birth.
+                (`"-version" (pop args-left))
+
+                ;; -nowait:  Emacsclient won't wait for a result.
+                (`"-nowait" (setq nowait t))
+
+                ;; -current-frame:  Don't create frames.
+                (`"-current-frame" (setq use-current-frame t))
+
+                ;; -display DISPLAY:
+                ;; Open X frames on the given display instead of the default.
+                (`"-display"
+                 (setq display (pop args-left))
+                 (if (zerop (length display)) (setq display nil)))
+
+                ;; -parent-id ID:
+                ;; Open X frame within window ID, via XEmbed.
+                (`"-parent-id"
+                 (setq parent-id (pop args-left))
+                 (if (zerop (length parent-id)) (setq parent-id nil)))
+
+                ;; -window-system:  Open a new X frame.
+                (`"-window-system"
+                 (setq dontkill t)
+                 (setq tty-name 'window-system))
+
+                ;; -resume:  Resume a suspended tty frame.
+                (`"-resume"
+                 (lexical-let ((terminal (process-get proc 'terminal)))
+                   (setq dontkill t)
+                   (push (lambda ()
+                           (when (eq (terminal-live-p terminal) t)
+                             (resume-tty terminal)))
+                         commands)))
+
+                ;; -suspend:  Suspend the client's frame.  (In case we
+                ;; get out of sync, and a C-z sends a SIGTSTP to
+                ;; emacsclient.)
+                (`"-suspend"
+                 (lexical-let ((terminal (process-get proc 'terminal)))
+                   (setq dontkill t)
+                   (push (lambda ()
+                           (when (eq (terminal-live-p terminal) t)
+                             (suspend-tty terminal)))
+                         commands)))
+
+                ;; -ignore COMMENT:  Noop; useful for debugging emacsclient.
+                ;; (The given comment appears in the server log.)
+                (`"-ignore"
+                 (setq dontkill t)
+                 (pop args-left))
+
+                ;; -tty DEVICE-NAME TYPE:  Open a new tty frame at the client.
+                (`"-tty"
+                 (setq tty-name (pop args-left)
+                       tty-type (pop args-left)
+                       dontkill (or dontkill
+                                    (not use-current-frame))))
+
+                ;; -position LINE[:COLUMN]:  Set point to the given
+                ;;  position in the next file.
+                (`"-position"
+                 (if (not (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?"
+                                        (car args-left)))
+                     (error "Invalid -position command in client args"))
+                 (let ((arg (pop args-left)))
+                   (setq filepos
+                         (cons (string-to-number (match-string 1 arg))
+                               (string-to-number (or (match-string 2 arg)
+                                                     ""))))))
+
+                ;; -file FILENAME:  Load the given file.
+                (`"-file"
+                 (let ((file (pop args-left)))
+                   (if coding-system
+                       (setq file (decode-coding-string file coding-system)))
+                   (setq file (expand-file-name file dir))
+                   (push (cons file filepos) files)
+                   (server-log (format "New file: %s %s"
+                                       file (or filepos "")) proc))
+                 (setq filepos nil))
+
+                ;; -eval EXPR:  Evaluate a Lisp expression.
+                (`"-eval"
+                 (if use-current-frame
+                     (setq use-current-frame 'always))
+                 (lexical-let ((expr (pop args-left)))
+                   (if coding-system
+                       (setq expr (decode-coding-string expr coding-system)))
+                   (push (lambda () (server-eval-and-print expr proc))
+                         commands)
+                   (setq filepos nil)))
+
+                ;; -env NAME=VALUE:  An environment variable.
+                (`"-env"
+                 (let ((var (pop args-left)))
+                   ;; XXX Variables should be encoded as in getenv/setenv.
+                   (process-put proc 'env
+                                (cons var (process-get proc 'env)))))
+
+                ;; -dir DIRNAME:  The cwd of the emacsclient process.
+                (`"-dir"
+                 (setq dir (pop args-left))
+                 (if coding-system
+                     (setq dir (decode-coding-string dir coding-system)))
+                 (setq dir (command-line-normalize-file-name dir)))
+
+                ;; Unknown command.
+                (arg (error "Unknown command: %s" arg))))
 
            (setq frame
                  (cond