;; emacsclient.el --- Pure Emacs Lisp implementation of emacsclient -*- lexical-binding: t; -*-
(require 'seq)

(defun emacsclient-default-paths ()
  (let ((xdg-runtime-dir (getenv "XDG_RUNTIME_DIR"))
        (xdg-config-home (getenv "XDG_CONFIG_HOME"))
        (home (getenv "HOME"))
        (tmpdir (getenv "TMPDIR"))
        (appdata (getenv "APPDATA"))
        (uid (user-uid)))
    (list
     ;; unix socket
     (getenv "EMACS_SOCKET_NAME")
     (and xdg-runtime-dir (format "%s/emacs/server" xdg-runtime-dir))
     (and tmpdir (format "%s/emacs%s/server" tmpdir uid))
     (format "/tmp/emacs%s/server" uid)

     ;; tcp config
     (getenv "EMACS_SERVER_FILE")
     (and home xdg-config-home (format "%s/%s/emacs/server/server"
                                       home xdg-config-home))
     (and home (format "%s/.config/emacs/server/server" home))
     (and home (format "%s/.emacs.d/server/server" home))
     (and appdata xdg-config-home (format "%s/%s/emacs/server/server"
                                          appdata xdg-config-home))
     (and appdata (format "%s/.config/emacs/server/server" appdata))
     (and appdata (format "%s/.emacs.d/server/server" appdata)))))

(defun emacsclient-default-path ()
  (seq-find #'file-exists-p (delq nil (emacsclient-default-paths))))

(defconst emacsclient-quote-map
  '(("&" . "&&") ("-" . "&-") ("\n" . "&n") (" " . "&_")))

(defconst emacsclient-unquote-map
  '(("&&" . "&") ("&-" . "-") ("&n" . "\n") ("&_" . " ")))

(defun emacsclient-quote (string)
  (replace-regexp-in-string "[-&\n ]"
                            (lambda (s) (cdr (assoc s emacsclient-quote-map)))
                            string))

(defun emacsclient-unquote (string)
  (replace-regexp-in-string "&[-&n_]"
                            (lambda (s) (cdr (assoc s emacsclient-unquote-map)))
                            string))

(defun emacsclient-sentinel (process _status)
  (when (eq (process-status process) 'closed)
    (terpri)
    (kill-emacs 0)))

(defun emacsclient-process-filter (process string)
  (let ((buffer (process-buffer process))
        (marker (process-mark process)))
    (when (buffer-live-p buffer)
      (with-current-buffer buffer
        (goto-char (point-max))
        (insert string)
        (goto-char marker)
        (if (looking-at-p "-error")
            (let* ((beg (save-excursion
                          (search-forward " " nil t)
                          (point)))
                   (end (point-max))
                   (arg (emacsclient-unquote (buffer-substring beg end))))
              (princ (format "error: %s\n" arg))
              (kill-emacs 1))
          (let ((beg (point)))
            (while (search-forward "\n" nil t)
              (let ((end (point)))
                (set-marker marker end)
                (let* ((line (buffer-substring beg end))
                       (args (split-string (string-trim-right line) " "))
                       (command (car args))
                       (arg (emacsclient-unquote (cadr args))))
                  (cond
                   ((equal command "-emacs-pid")) ; ignore
                   ((member command '("-print" "-print-nonl"))
                    (princ arg))
                   (t
                    (princ (format "unknown command: %S %S" command arg))
                    (kill-emacs 1))))
                (setq beg end)))))))))

(defun emacsclient-unix-eval (path code)
  (let ((proc (make-network-process :name "emacsclient"
                                    :buffer "*emacsclient*"
                                    :family 'local
                                    :service path
                                    :sentinel #'emacsclient-sentinel
                                    :filter #'emacsclient-process-filter)))
    (process-send-string proc (format "-eval %s\n" (emacsclient-quote code)))
    (while t
      (accept-process-output proc 0.1))))

(defconst emacsclient-tcp-config-meta-line
  (rx bol (group (+ (not (any ": ")))) ":" (group (+ (any (?0 . ?9)))) " "))

(defconst emacsclient-tcp-config-secret-line
  (rx bol (= 64 (any (?! . ?~))) eol))

(defun emacsclient-parse-tcp-config (path)
  (let (meta)
    (with-temp-buffer
      (insert-file-contents-literally path)
      (goto-char (point-min))
      (when (looking-at emacsclient-tcp-config-meta-line)
        (push `(host . ,(match-string 1)) meta)
        (push `(port . ,(string-to-number (match-string 2))) meta))
      (forward-line 1)
      (when (looking-at emacsclient-tcp-config-secret-line)
        (push `(secret . ,(match-string 0)) meta)))
    meta))

(defun emacsclient-tcp-eval (path code)
  (let* ((config (emacsclient-parse-tcp-config path))
         (host (cdr (assoc 'host config)))
         (port (cdr (assoc 'port config)))
         (secret (cdr (assoc 'secret config)))
         (proc (make-network-process :name "emacsclient"
                                     :buffer "*emacsclient*"
                                     :host host
                                     :service port
                                     :linger 1
                                     :sentinel #'emacsclient-sentinel
                                     :filter #'emacsclient-process-filter)))
    (process-send-string proc (format "-auth %s -eval %s\n"
                                      secret
                                      (emacsclient-quote code)))
    (while t
      (accept-process-output proc 0.1))))

(defun emacsclient-eval (path code)
  (if (file-regular-p path)
      (emacsclient-tcp-eval path code)
    (emacsclient-unix-eval path code)))

(when (member "-scriptload" command-line-args)
  (when (not argv)
    (message "usage: emacs --script emacsclient.el <code>")
    (kill-emacs 1))
  (let ((code (pop argv))
        (path (or (emacsclient-default-path) (getenv "EMACSCLIENT_FILE"))))
    (when (not path)
      (message "couldn't detect path")
      (kill-emacs 1))
    (princ (emacsclient-eval path code))
    (terpri)))