Skip to content

Instantly share code, notes, and snippets.

@jikamens
Last active August 10, 2024 18:03
Keep the Emacs server running in the Emacs in the current active systemd session
;; Copyright 2023 Jonathan Kamens <jik@kamens.us>.
;;
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation, either version 3 of the License, or (at your option)
;; any later version. See <https://www.gnu.org/licenses/>.
;;
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.
;; Keep the Emacs server running on the currently active systemd session
;;
;; To make this work, we need to do three things:
;; 1. Know what session we're running in.
;; 2. Know when our session becomes active.
;; 3. Know whether the server socket is the one we created.
;;
;; We keep the following state:
;; 1. The identifier of the session we're running in.
;; 2. The inode of the server socket immediately after we created it.
;; 3. The IdleHint from our session.
;; 4. The timer identifier.
;;
;; Every time our timer callback runs, we do the following:
;; 1. Check if we've switched from idle to active and stop if not.
;; 2. Store current idle hint.
;; 3. Check if the server socket matches our stored inode and stop if so.
;; 4. Start the server.
;; 5. Store the server socket's inode.
(provide 'server-sucker)
(defvar server-sucker-session-id nil)
(defvar server-sucker-inode nil)
(defvar server-sucker-idle-hint nil)
(defvar server-sucker-timer nil)
(setq server-sucker-log-name "*server-sucker-log*")
(defun server-sucker-log (&rest args)
(with-current-buffer (get-buffer-create server-sucker-log-name)
(let ((message (apply 'format args))
;; I don't understand why it's necessary to save point here and
;; restore it explicitly below. As far as I can tell from the
;; documentation `save-excursion` is supposed to do that, but it's
;; not.
(current (point))
(max (point-max)))
(goto-char (point-max))
(insert (current-time-string))
(insert ": ")
(insert message)
(when (not (string-match-p "\n$" message))
(insert "\n"))
(goto-char (if (= current max) (point-max) current)))))
(defun get-systemd-session-id ()
(with-temp-buffer
;; I honestly don't understand why there isn't a loginctl mode that returns
;; the caller's session in human-readable format.
(call-process "loginctl" nil (current-buffer) nil "session-status")
(goto-char (point-min))
(looking-at "[0-9]+")
(let ((session-id (match-string 0)))
(server-sucker-log "get-systemd-session-id: %s" session-id)
session-id)))
(defun get-systemd-idle-hint (&optional session-id)
(when (or session-id (setq session-id (get-systemd-session-id)))
(with-temp-buffer
(call-process "loginctl" nil (current-buffer) nil "show-session"
session-id)
(goto-char (point-min))
(search-forward-regexp "IdleHint=\\(.+\\)")
(let ((idle-hint (match-string 1)))
(server-sucker-log "get-systemd-idle-hint: %s" idle-hint)
idle-hint))))
(defun get-server-socket-inode ()
(let* ((server-socket (if server-process
(cadr (process-contact server-process))
nil))
(attributes (and server-socket (file-attributes server-socket)))
(inode (and attributes (file-attribute-inode-number attributes))))
(server-sucker-log "get-server-socket-inode: socket=%s inode=%s"
server-socket inode)
inode))
(defun suck-server ()
(with-current-buffer (get-buffer-create server-sucker-log-name)
(erase-buffer))
(when (server-running-p)
(server-sucker-log "suck-server: server-force-delete")
(server-force-delete))
(server-sucker-log "suck-server: server-start")
(server-start)
(setq server-sucker-inode (get-server-socket-inode)))
(defun current-idle-seconds ()
(let ((idle-time (current-idle-time)))
(if (not idle-time)
0
(time-convert idle-time 'integer))))
(defun server-sucker-callback ()
(catch 'return
(let ((new-idle-hint (get-systemd-idle-hint server-sucker-session-id))
(old-idle-hint server-sucker-idle-hint)
(idle-time (current-idle-seconds)))
(setq server-sucker-idle-hint new-idle-hint)
(server-sucker-log
"server-sucker-callback: idle-time=%s server-sucker-idle-hint=%s new-idle-hint=%s"
idle-time old-idle-hint new-idle-hint)
(when (not (or (< idle-time 5)
(and (equal old-idle-hint "yes")
(equal new-idle-hint "no"))))
(throw 'return nil)))
(let ((new-inode (get-server-socket-inode)))
(when (not (equal new-inode server-sucker-inode))
(suck-server)
(throw 'return nil))
(server-sucker-log
"server-sucker-callback: new-inode=%d server-sucker-inode=%d"
new-inode server-sucker-inode))))
(suck-server)
(setq server-sucker-session-id (get-systemd-session-id))
(setq server-sucker-idle-hint (get-systemd-idle-hint server-sucker-session-id))
(when server-sucker-timer
(cancel-timer server-sucker-timer))
(setq server-sucker-timer (run-at-time "0" 5 'server-sucker-callback))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment