Merge changes from emacs-23 branch

[gnu-emacs] / lisp / server.el

diff --git a/lisp/server.el b/lisp/server.el
index e8a0125f554a8af07c7ee90a3237233061a4440e..b2cb829adf759fcca110c77704a07649a3a85a25 100644 (file)
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -344,7 +344,8 @@ If CLIENT is non-nil, add a description of it to the logged message."
   ;; for possible servers before doing anything, so it *should* be ours.
   (and (process-contact proc :server)
        (eq (process-status proc) 'closed)
-       (ignore-errors (delete-file (process-get proc :server-file))))
+       (ignore-errors
+       (delete-file (process-get proc :server-file))))
   (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc)
   (server-delete-client proc))
 
@@ -517,7 +518,9 @@ To force-start a server, do \\[server-force-delete] and then
       ;; Delete the socket files made by previous server invocations.
       (if (not (eq t (server-running-p server-name)))
          ;; Remove any leftover socket or authentication file
-         (ignore-errors (delete-file server-file))
+         (ignore-errors
+          (let (delete-by-moving-to-trash)
+            (delete-file server-file)))
        (setq server-mode nil) ;; already set by the minor mode code
        (display-warning
         'server
@@ -574,7 +577,7 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
                   (loop
                      ;; The auth key is a 64-byte string of random chars in the
                      ;; range `!'..`~'.
-                     for i below 64
+                     repeat 64
                      collect (+ 33 (random 94)) into auth
                      finally return (concat auth))))
              (process-put server-process :auth-key auth-key)
@@ -600,7 +603,7 @@ NAME defaults to `server-name'.  With argument, ask for NAME."
                                    server-auth-dir
                                  server-socket-dir))))
     (condition-case nil
-       (progn
+       (let (delete-by-moving-to-trash)
          (delete-file file)
          (message "Connection file %S deleted" file))
       (file-error
@@ -708,7 +711,7 @@ Server mode runs a process that accepts commands from the
                                      (number-to-string (emacs-pid)) "\n"))
     frame))
 
-(defun server-create-window-system-frame (display nowait proc)
+(defun server-create-window-system-frame (display nowait proc parent-id)
   (add-to-list 'frame-inherited-parameters 'client)
   (if (not (fboundp 'make-frame-on-display))
       (progn
@@ -724,12 +727,14 @@ Server mode runs a process that accepts commands from the
     (let* ((params `((client . ,(if nowait 'nowait proc))
                      ;; This is a leftover, see above.
                      (environment . ,(process-get proc 'env))))
-           (frame (make-frame-on-display
-                   (or display
-                       (frame-parameter nil 'display)
-                       (getenv "DISPLAY")
-                       (error "Please specify display"))
-                   params)))
+          (display (or display
+                       (frame-parameter nil 'display)
+                       (getenv "DISPLAY")
+                       (error "Please specify display")))
+          frame)
+      (if parent-id
+         (push (cons 'parent-id (string-to-number parent-id)) params))
+      (setq frame (make-frame-on-display display params))
       (server-log (format "%s created" frame) proc)
       (select-frame frame)
       (process-put proc 'frame frame)
@@ -897,15 +902,16 @@ The following commands are accepted by the client:
                (coding-system (and (default-value 'enable-multibyte-characters)
                                    (or file-name-coding-system
                                        default-file-name-coding-system)))
-               nowait ; t if emacsclient does not want to wait for us.
-               frame ; The frame that was opened for the client (if any).
-               display              ; Open the frame on this display.
-               dontkill       ; t if the client should not be killed.
+               nowait     ; t if emacsclient does not want to wait for us.
+               frame      ; Frame opened for the client (if any).
+               display    ; Open frame on this display.
+               parent-id  ; Window ID for XEmbed
+               dontkill   ; t if client should not be killed.
                commands
                dir
                use-current-frame
-               tty-name       ;nil, `window-system', or the tty name.
-               tty-type             ;string.
+               tty-name   ; nil, `window-system', or the tty name.
+               tty-type   ; string.
                files
                filepos
                command-line-args-left
@@ -932,6 +938,12 @@ The following commands are accepted by the client:
                  (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)
@@ -1036,7 +1048,8 @@ The following commands are accepted by the client:
                    (setq tty-name nil tty-type nil)
                    (if display (server-select-display display)))
                   ((eq tty-name 'window-system)
-                   (server-create-window-system-frame display nowait proc))
+                   (server-create-window-system-frame display nowait proc
+                                                      parent-id))
                   ;; When resuming on a tty, tty-name is nil.
                   (tty-name
                    (server-create-tty-frame tty-name tty-type proc))))