(string :tag "Name or IP address")
(const :tag "Local" nil))
:version "22.1")
+;;;###autoload
(put 'server-host 'risky-local-variable t)
+(defcustom server-port nil
+ "The port number that the server process should listen on."
+ :group 'server
+ :type '(choice
+ (string :tag "Port number")
+ (const :tag "Random" nil))
+ :version "24.1")
+;;;###autoload
+(put 'server-port 'risky-local-variable t)
+
(defcustom server-auth-dir (locate-user-emacs-file "server/")
"Directory for server authentication files.
:group 'server
:type 'directory
:version "22.1")
+;;;###autoload
(put 'server-auth-dir 'risky-local-variable t)
(defcustom server-raise-frame t
;; 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))
;; 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
;; The other args depend on the kind of socket used.
(if server-use-tcp
(list :family 'ipv4 ;; We're not ready for IPv6 yet
- :service t
- :host (or server-host "127.0.0.1") ;; See bug#6781
+ :service (or server-port t)
+ :host (or server-host 'local)
:plist '(:authenticated nil))
(list :family 'local
:service server-file
(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)
(setq buffer-file-coding-system 'no-conversion)
(insert (format-network-address
(process-contact server-process :local))
- " " (int-to-string (emacs-pid))
+ " " (number-to-string (emacs-pid)) ; Kept for compatibility
"\n" auth-key)))))))))
(defun server-force-stop ()
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
;; Display *scratch* by default.
(switch-to-buffer (get-buffer-create "*scratch*") 'norecord)
- ;; Reply with our pid.
- (server-send-string proc (concat "-emacs-pid "
- (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
(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)
(server-log "Authentication failed" proc)
(server-send-string
proc (concat "-error " (server-quote-arg "Authentication failed")))
+ ;; Before calling `delete-process', give emacsclient time to
+ ;; receive the error string and shut down on its own.
+ (sit-for 1)
(delete-process proc)
;; We return immediately
(return-from server-process-filter)))
(condition-case err
(progn
(server-add-client proc)
+ ;; Send our pid
+ (server-send-string proc (concat "-emacs-pid "
+ (number-to-string (emacs-pid)) "\n"))
(if (not (string-match "\n" string))
;; Save for later any partial line that remains.
(when (> (length string) 0)
(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
(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 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))))
(condition-case err
(let* ((buffers
(when files
- (run-hooks 'pre-command-hook)
- (prog1 (server-visit-files files proc nowait)
- (run-hooks 'post-command-hook)))))
+ (server-visit-files files proc nowait))))
(mapc 'funcall (nreverse commands))
proc (concat "-error " (server-quote-arg
(error-message-string err))))
(server-log (error-message-string err) proc)
+ ;; Before calling `delete-process', give emacsclient time to
+ ;; receive the error string and shut down on its own.
+ (sit-for 5)
(delete-process proc)))
(defun server-goto-line-column (line-col)
(obuf (get-file-buffer filen)))
(add-to-history 'file-name-history filen)
(if (null obuf)
- (set-buffer (find-file-noselect filen))
+ (progn
+ (run-hooks 'pre-command-hook)
+ (set-buffer (find-file-noselect filen)))
(set-buffer obuf)
+ ;; separately for each file, in sync with post-command hooks,
+ ;; with the new buffer current:
+ (run-hooks 'pre-command-hook)
(cond ((file-exists-p filen)
(when (not (verify-visited-file-modtime obuf))
(revert-buffer t nil)))
(unless server-buffer-clients
(setq server-existing-buffer t)))
(server-goto-line-column (cdr file))
- (run-hooks 'server-visit-hook))
+ (run-hooks 'server-visit-hook)
+ ;; hooks may be specific to current buffer:
+ (run-hooks 'post-command-hook))
(unless nowait
;; When the buffer is killed, inform the clients.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
\f
(provide 'server)
-;; arch-tag: 1f7ecb42-f00a-49f8-906d-61995d84c8d6
;;; server.el ends here