(defgroup gnuserv nil
"The gnuserv suite of programs to talk to Emacs from outside."
:group 'environment
:group 'processes
:group 'terminals)
(define-obsolete-variable-alias 'server-frame 'gnuserv-frame)
(define-obsolete-variable-alias 'server-done-function
'gnuserv-done-function)
(define-obsolete-variable-alias 'server-done-temp-file-function
'gnuserv-done-temp-file-function)
(define-obsolete-variable-alias 'server-find-file-function
'gnuserv-find-file-function)
(define-obsolete-variable-alias 'server-program
'gnuserv-program)
(define-obsolete-variable-alias 'server-visit-hook
'gnuserv-visit-hook)
(define-obsolete-variable-alias 'server-done-hook
'gnuserv-done-hook)
(define-obsolete-variable-alias 'server-kill-quietly
'gnuserv-kill-quietly)
(define-obsolete-variable-alias 'server-temp-file-regexp
'gnuserv-temp-file-regexp)
(define-obsolete-variable-alias 'server-make-temp-file-backup
'gnuserv-make-temp-file-backup)
(defcustom gnuserv-frame nil
"*The frame to be used to display all edited files.
If nil, then a new frame is created for each file edited.
If t, then the currently selected frame will be used.
If a function, then this will be called with a symbol `x' or `tty' as the
only argument, and its return value will be interpreted as above."
:tag "Gnuserv Frame"
:type '(radio (const :tag "Create new frame each time" nil)
(const :tag "Use selected frame" t)
(function-item :tag "Use main Emacs frame"
gnuserv-main-frame-function)
(function-item :tag "Use visible frame, otherwise create new"
gnuserv-visible-frame-function)
(function-item :tag "Create special Gnuserv frame and use it"
gnuserv-special-frame-function)
(function :tag "Other"))
:group 'gnuserv
:group 'frames)
(defcustom gnuserv-frame-plist nil
"*Plist of frame properties for creating a gnuserv frame."
:type 'plist
:group 'gnuserv
:group 'frames)
(defcustom gnuserv-done-function 'kill-buffer
"*Function used to remove a buffer after editing.
It is called with one BUFFER argument. Functions such as `kill-buffer' and
`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
:type '(radio (function-item kill-buffer)
(function-item bury-buffer)
(function :tag "Other"))
:group 'gnuserv)
(defcustom gnuserv-done-temp-file-function 'kill-buffer
"*Function used to remove a temporary buffer after editing.
It is called with one BUFFER argument. Functions such as `kill-buffer' and
`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
:type '(radio (function-item kill-buffer)
(function-item bury-buffer)
(function :tag "Other"))
:group 'gnuserv)
(defcustom gnuserv-find-file-function 'find-file
"*Function to visit a file with.
It takes one argument, a file name to visit."
:type 'function
:group 'gnuserv)
(defcustom gnuserv-view-file-function 'view-file
"*Function to view a file with.
It takes one argument, a file name to view."
:type '(radio (function-item view-file)
(function-item find-file-read-only)
(function :tag "Other"))
:group 'gnuserv)
(defcustom gnuserv-program "gnuserv"
"*Program to use as the editing server."
:type 'string
:group 'gnuserv)
(defcustom gnuserv-visit-hook nil
"*Hook run after visiting a file."
:type 'hook
:group 'gnuserv)
(defcustom gnuserv-done-hook nil
"*Hook run when done editing a buffer for the Emacs server.
The hook functions are called after the file has been visited, with the
current buffer set to the visiting buffer."
:type 'hook
:group 'gnuserv)
(defcustom gnuserv-init-hook nil
"*Hook run after the server is started."
:type 'hook
:group 'gnuserv)
(defcustom gnuserv-shutdown-hook nil
"*Hook run before the server exits."
:type 'hook
:group 'gnuserv)
(defcustom gnuserv-kill-quietly nil
"*Non-nil means to kill buffers with clients attached without requiring confirmation."
:type 'boolean
:group 'gnuserv)
(defcustom gnuserv-temp-file-regexp
(concat "^" (temp-directory) "/Re\\|/draft$")
"*Regexp which should match filenames of temporary files deleted
and reused by the programs that invoke the Emacs server."
:type 'regexp
:group 'gnuserv)
(defcustom gnuserv-make-temp-file-backup nil
"*Non-nil makes the server backup temporary files also."
:type 'boolean
:group 'gnuserv)
(defstruct gnuclient
"An object that encompasses several buffers in one.
Normally, a client connecting to Emacs will be assigned an id, and
will request editing of several files.
ID - Client id (integer).
BUFFERS - List of buffers that \"belong\" to the client.
NOTE: one buffer can belong to several clients.
DEVICE - The device this client is on. If the device was also created.
by a client, it will be placed to `gnuserv-devices' list.
FRAME - Frame created by the client, or nil if the client didn't
create a frame.
All the slots default to nil."
(id nil)
(buffers nil)
(device nil)
(frame nil))
(defvar gnuserv-process nil
"The current gnuserv process.")
(defvar gnuserv-string ""
"The last input string from the server.")
(defvar gnuserv-current-client nil
"The client we are currently talking to.")
(defvar gnuserv-clients nil
"List of current gnuserv clients.
Each element is a gnuclient structure that identifies a client.")
(defvar gnuserv-devices nil
"List of devices created by clients.")
(defvar gnuserv-special-frame nil
"Frame created specially for Server.")
(defvar gnuserv-minor-mode nil)
(make-variable-buffer-local 'gnuserv-mode)
(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist
:test 'equal)
(defun gnuserv-main-frame-function (type)
"Return a sensible value for the main Emacs frame."
(if (or (eq type 'x)
(eq type 'mswindows))
(car (frame-list))
nil))
(defun gnuserv-visible-frame-function (type)
"Return a frame if there is a frame that is truly visible, nil otherwise.
This is meant in the X sense, so it will not return frames that are on another
visual screen. Totally visible frames are preferred. If none found, return nil."
(if (or (eq type 'x)
(eq type 'mswindows))
(cond ((car (filtered-frame-list 'frame-totally-visible-p
(selected-device))))
((car (filtered-frame-list (lambda (frame)
(eq t (frame-visible-p frame)))
(selected-device)))))
nil))
(defun gnuserv-special-frame-function (type)
"Create a special frame for Gnuserv and return it on later invocations."
(unless (frame-live-p gnuserv-special-frame)
(setq gnuserv-special-frame (make-frame gnuserv-frame-plist)))
gnuserv-special-frame)
(defun gnuserv-sentinel (proc msg)
(let ((msgstring (concat "Gnuserv process %s; restart with `%s'"))
(keystring (substitute-command-keys "\\[gnuserv-start]")))
(case (process-status proc)
(exit
(message msgstring "exited" keystring)
(gnuserv-prepare-shutdown))
(signal
(message msgstring "killed" keystring)
(gnuserv-prepare-shutdown))
(closed
(message msgstring "closed" keystring))
(gnuserv-prepare-shutdown))))
(defun gnuserv-process-filter (proc string)
"Process gnuserv client requests to execute Emacs commands."
(setq gnuserv-string (concat gnuserv-string string))
(when (string-match "\C-d\n?\\'" gnuserv-string)
(cond ((string-match "\\`[0-9]+" gnuserv-string) (let ((header (read-from-string gnuserv-string)))
(setq gnuserv-current-client (car header))
(condition-case oops
(eval (car (read-from-string gnuserv-string (cdr header))))
(error (setq gnuserv-string "")
(when gnuserv-current-client
(gnuserv-write-to-client gnuserv-current-client oops))
(setq gnuserv-current-client nil)
(signal (car oops) (cdr oops)))
(quit (setq gnuserv-string "")
(when gnuserv-current-client
(gnuserv-write-to-client gnuserv-current-client oops))
(setq gnuserv-current-client nil)
(signal 'quit nil)))
(setq gnuserv-string "")))
(t
(let ((response (car (split-string gnuserv-string "\C-d"))))
(setq gnuserv-string "")
(error "%s: invalid response from gnuserv" response))))))
(defun gnuserv-write-to-client (client-id form)
"Write the given form to the given client via the gnuserv process."
(when (eq (process-status gnuserv-process) 'run)
(let* ((result (format "%s" form))
(s (format "%s/%d:%s\n" client-id
(length result) result)))
(process-send-string gnuserv-process s))))
(defun gnuserv-eval (form)
"Evaluate form and return result to client."
(gnuserv-write-to-client gnuserv-current-client (eval form))
(setq gnuserv-current-client nil))
(defun gnuserv-eval-quickly (form)
"Let client know that we've received the request, and then eval the form.
This order is important as not to keep the client waiting."
(gnuserv-write-to-client gnuserv-current-client nil)
(setq gnuserv-current-client nil)
(eval form))
(defun gnuserv-edit-files (type list &rest flags)
"For each (line-number . file) pair in LIST, edit the file at line-number.
The visited buffers are memorized, so that when \\[gnuserv-edit] is invoked
in such a buffer, or when it is killed, or the client's device deleted, the
client will be invoked that the edit is finished.
TYPE should either be a (tty TERM) list, or (x DISPLAY) list.
If a flag is `quick', just edit the files in Emacs.
If a flag is `view', view the files read-only."
(let (quick view)
(mapc (lambda (flag)
(case flag
(quick (setq quick t))
(view (setq view t))
(t (error "Invalid flag %s" flag))))
flags)
(let* ((old-device-num (length (device-list)))
(new-frame nil)
(dest-frame (if (functionp gnuserv-frame)
(funcall gnuserv-frame (car type))
gnuserv-frame))
(device (cond ((frame-live-p dest-frame)
(frame-device dest-frame))
((null dest-frame)
(case (car type)
(tty tty (cdr type))
(x (make-x-device (cadr type)))
(mswindows (make-mswindows-device))
(t (error "Invalid device type"))))
(t
(selected-device))))
(frame (cond ((frame-live-p dest-frame)
dest-frame)
((null dest-frame)
(setq new-frame (make-frame gnuserv-frame-plist
device))
new-frame)
(t (selected-frame))))
(client (make-gnuclient :id gnuserv-current-client
:device device
:frame new-frame)))
(select-frame frame)
(setq gnuserv-current-client nil)
(and (/= old-device-num (length (device-list)))
(push device gnuserv-devices))
(and (frame-iconified-p frame)
(deiconify-frame frame))
(while list
(let ((line (caar list)) (path (cdar list)))
(select-frame frame)
(funcall (if view
gnuserv-view-file-function
gnuserv-find-file-function)
path)
(goto-line line)
(unless (or quick view)
(pushnew (current-buffer) (gnuclient-buffers client))
(setq gnuserv-minor-mode t)
(if (and (featurep 'menubar) current-menubar)
(progn (set-buffer-menubar current-menubar)
(add-menu-button nil ["Done" gnuserv-edit]))
))
(run-hooks 'gnuserv-visit-hook)
(pop list)))
(cond
((or quick view)
(gnuserv-write-to-client (gnuclient-id client) nil))
(t
(push client gnuserv-clients)
(if (and (not (or quick view))
(gnuclient-buffers client))
(message "%s"
(substitute-command-keys
"Type `\\[gnuserv-edit]' to finish editing"))
(or dest-frame
(message "%s"
(substitute-command-keys
"Type `\\[delete-frame]' to finish editing")))))))))
(add-hook 'kill-emacs-hook 'gnuserv-kill-all-clients t)
(defun gnuserv-buffer-clients (buffer)
"Return a list of clients to which BUFFER belongs."
(let (res)
(dolist (client gnuserv-clients)
(when (memq buffer (gnuclient-buffers client))
(push client res)))
res))
(defun gnuserv-buffer-p (buffer)
(member* buffer gnuserv-clients
:test 'memq
:key 'gnuclient-buffers))
(defun gnuserv-kill-buffer-function ()
"Remove the buffer from the buffer lists of all the clients it belongs to.
Any client that remains \"empty\" after the removal is informed that the
editing has ended."
(let* ((buf (current-buffer)))
(dolist (client (gnuserv-buffer-clients buf))
(callf2 delq buf (gnuclient-buffers client))
(when (null (gnuclient-buffers client))
(gnuserv-kill-client client)))))
(add-hook 'kill-buffer-hook 'gnuserv-kill-buffer-function)
(defun gnuserv-kill-buffer-query-function ()
(or gnuserv-kill-quietly
(not (gnuserv-buffer-p (current-buffer)))
(yes-or-no-p
(format "Buffer %s belongs to gnuserv client(s); kill anyway? "
(current-buffer)))))
(add-hook 'kill-buffer-query-functions
'gnuserv-kill-buffer-query-function)
(defun gnuserv-kill-emacs-query-function ()
(or gnuserv-kill-quietly
(not (some 'gnuclient-buffers gnuserv-clients))
(yes-or-no-p "Gnuserv buffers still have clients; exit anyway? ")))
(add-hook 'kill-emacs-query-functions
'gnuserv-kill-emacs-query-function)
(defun gnuserv-check-device (device)
(when (memq device gnuserv-devices)
(dolist (client gnuserv-clients)
(when (eq device (gnuclient-device client))
(gnuserv-kill-client client t))))
(callf2 delq device gnuserv-devices))
(add-hook 'delete-device-hook 'gnuserv-check-device)
(defun gnuserv-temp-file-p (buffer)
"Return non-nil if BUFFER contains a file considered temporary.
These are files whose names suggest they are repeatedly
reused to pass information to another program.
The variable `gnuserv-temp-file-regexp' controls which filenames
are considered temporary."
(and (buffer-file-name buffer)
(string-match gnuserv-temp-file-regexp (buffer-file-name buffer))))
(defun gnuserv-kill-client (client &optional leave-frame)
"Kill the gnuclient CLIENT.
This will do away with all the associated buffers. If LEAVE-FRAME,
the function will not remove the frames associated with the client."
(callf2 delq client gnuserv-clients)
(mapc 'gnuserv-buffer-done-1 (gnuclient-buffers client))
(unless leave-frame
(let ((device (gnuclient-device client)))
(when (and (gnuclient-frame client)
(frame-live-p (gnuclient-frame client))
(second (device-frame-list device)))
(delete-frame (gnuclient-frame client)))
(when (and (device-live-p device)
(memq device gnuserv-devices)
(second (device-list))
(not (member* device gnuserv-clients
:key 'gnuclient-device)))
(delete-device device))))
(gnuserv-write-to-client (gnuclient-id client) nil))
(defun gnuserv-buffer-done-1 (buffer)
(dolist (client (gnuserv-buffer-clients buffer))
(callf2 delq buffer (gnuclient-buffers client))
(when (null (gnuclient-buffers client))
(gnuserv-kill-client client)))
(save-excursion
(set-buffer buffer)
(run-hooks 'gnuserv-done-hook)
(setq gnuserv-minor-mode nil)
(if (and (featurep 'menubar) current-menubar)
(delete-menu-item '("Done")))
(funcall (if (gnuserv-temp-file-p buffer)
gnuserv-done-temp-file-function
gnuserv-done-function)
buffer)))
(defun gnuserv-next-buffer ()
(let* ((frame (selected-frame))
(device (selected-device))
client)
(cond
((setq client
(car (member* frame gnuserv-clients :key 'gnuclient-frame)))
(car (gnuclient-buffers client)))
((and
(memq (selected-device) gnuserv-devices)
(setq client
(car (member* device gnuserv-clients :key 'gnuclient-device))))
(car (gnuclient-buffers client)))
((setq client
(car (member-if-not #'null gnuserv-clients
:key 'gnuclient-buffers)))
(car (gnuclient-buffers client)))
(t nil))))
(defun gnuserv-buffer-done (buffer)
"Mark BUFFER as \"done\" for its client(s).
Does the save/backup queries first, and calls `gnuserv-done-function'."
(unless (gnuserv-buffer-p buffer)
(error "%s does not belong to a gnuserv client" buffer))
(if (gnuserv-temp-file-p buffer)
(let ((version-control nil)
(buffer-backed-up (not gnuserv-make-temp-file-backup)))
(save-buffer))
(if (and (buffer-modified-p)
(y-or-n-p (concat "Save file " buffer-file-name "? ")))
(save-buffer buffer)))
(gnuserv-buffer-done-1 buffer))
(defun gnuserv-kill-all-clients ()
"Kill all the gnuserv clients. Ruthlessly."
(mapc 'gnuserv-kill-client gnuserv-clients))
(defun gnuserv-prepare-shutdown ()
(setq allow-deletion-of-last-visible-frame nil)
(run-hooks 'gnuserv-shutdown-hook))
(defun gnuserv-shutdown ()
"Shutdown the gnuserv server, if one is currently running.
All the clients will be disposed of via the normal methods."
(interactive)
(gnuserv-kill-all-clients)
(when gnuserv-process
(set-process-sentinel gnuserv-process nil)
(gnuserv-prepare-shutdown)
(condition-case ()
(delete-process gnuserv-process)
(error nil))
(setq gnuserv-process nil)))
(defun gnuserv-start-1 (&optional leave-dead)
(gnuserv-shutdown)
(unless leave-dead
(setq gnuserv-string ""
gnuserv-current-client nil)
(let ((process-connection-type t))
(setq gnuserv-process
(start-process "gnuserv" nil gnuserv-program)))
(set-process-sentinel gnuserv-process 'gnuserv-sentinel)
(set-process-filter gnuserv-process 'gnuserv-process-filter)
(process-kill-without-query gnuserv-process)
(setq allow-deletion-of-last-visible-frame t)
(run-hooks 'gnuserv-init-hook)))
(defun gnuserv-running-p ()
"Return non-nil if a gnuserv process is running from this XEmacs session."
(not (not gnuserv-process)))
(defun gnuserv-start (&optional leave-dead)
"Allow this Emacs process to be a server for client processes.
This starts a gnuserv communications subprocess through which
client \"editors\" (gnuclient and gnudoit) can send editing commands to
this Emacs job. See the gnuserv(1) manual page for more details.
Prefix arg means just kill any existing server communications subprocess."
(interactive "P")
(and gnuserv-process
(not leave-dead)
(message "Restarting gnuserv"))
(gnuserv-start-1 leave-dead))
(defun gnuserv-edit (&optional count)
"Mark the current gnuserv editing buffer as \"done\", and switch to next one.
Run with a numeric prefix argument, repeat the operation that number
of times. If given a universal prefix argument, close all the buffers
of this buffer's clients.
The `gnuserv-done-function' (bound to `kill-buffer' by default) is
called to dispose of the buffer after marking it as done.
Files that match `gnuserv-temp-file-regexp' are considered temporary and
are saved unconditionally and backed up if `gnuserv-make-temp-file-backup'
is non-nil. They are disposed of using `gnuserv-done-temp-file-function'
\(also bound to `kill-buffer' by default).
When all of a client's buffers are marked as \"done\", the client is notified."
(interactive "P")
(when (null count)
(setq count 1))
(cond ((numberp count)
(while (natnump (decf count))
(let ((frame (selected-frame)))
(gnuserv-buffer-done (current-buffer))
(when (eq frame (selected-frame))
(let ((next (gnuserv-next-buffer)))
(when next
(switch-to-buffer next)))))))
(count
(let* ((buf (current-buffer))
(clients (gnuserv-buffer-clients buf)))
(unless clients
(error "%s does not belong to a gnuserv client" buf))
(mapc 'gnuserv-kill-client (gnuserv-buffer-clients buf))))))
(global-set-key "\C-x#" 'gnuserv-edit)
(provide 'gnuserv)