428
+ − 1 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv
+ − 2 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc.
+ − 3
456
+ − 4 ;; Version: 3.12
428
+ − 5 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el
+ − 6 ;; Hrvoje Niksic <hniksic@xemacs.org>
+ − 7 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>,
+ − 8 ;; Hrvoje Niksic <hniksic@xemacs.org>
+ − 9 ;; Keywords: environment, processes, terminals
+ − 10
+ − 11 ;; This file is part of XEmacs.
+ − 12
+ − 13 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 14 ;; under the terms of the GNU General Public License as published by
+ − 15 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 16 ;; any later version.
+ − 17
+ − 18 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 21 ;; General Public License for more details.
+ − 22
+ − 23 ;; You should have received a copy of the GNU General Public License
+ − 24 ;; along with XEmacs; see the file COPYING. If not, write to the
+ − 25 ;; Free Software Foundation, 59 Temple Place - Suite 330,
+ − 26 ;; Boston, MA 02111-1307, USA.
+ − 27
+ − 28 ;;; Synched up with: Not in FSF.
+ − 29
+ − 30 ;;; Commentary:
+ − 31
+ − 32 ;; Gnuserv is run when Emacs needs to operate as a server for other
+ − 33 ;; processes. Specifically, any number of files can be attached for
+ − 34 ;; editing to a running XEmacs process using the `gnuclient' program.
+ − 35
+ − 36 ;; Use `M-x gnuserv-start' to start the server and `gnuclient files'
+ − 37 ;; to load them to XEmacs. When you are done with a buffer, press
+ − 38 ;; `C-x #' (`M-x gnuserv-edit'). You can put (gnuserv-start) to your
+ − 39 ;; .emacs, and enable `gnuclient' as your Unix "editor". When all the
+ − 40 ;; buffers for a client have been edited and exited with
+ − 41 ;; `gnuserv-edit', the client "editor" will return to the program that
+ − 42 ;; invoked it.
+ − 43
+ − 44 ;; Your editing commands and Emacs' display output go to and from the
+ − 45 ;; terminal or X display in the usual way. If you are running under
+ − 46 ;; X, a new X frame will be open for each gnuclient. If you are on a
+ − 47 ;; TTY, this TTY will be attached as a new device to the running
+ − 48 ;; XEmacs, and will be removed once you are done with the buffer.
+ − 49
+ − 50 ;; To evaluate a Lisp form in a running Emacs, use the `-eval'
+ − 51 ;; argument of gnuclient. To simplify this, we provide the `gnudoit'
+ − 52 ;; shell script. For example `gnudoit "(+ 2 3)"' will print `5',
+ − 53 ;; whereas `gnudoit "(gnus)"' will fire up your favorite newsreader.
+ − 54 ;; Like gnuclient, `gnudoit' requires the server to be started prior
+ − 55 ;; to using it.
+ − 56
+ − 57 ;; For more information you can refer to man pages of gnuclient,
+ − 58 ;; gnudoit and gnuserv, distributed with XEmacs.
+ − 59
+ − 60 ;; gnuserv.el was originally written by Andy Norman as an improvement
+ − 61 ;; over William Sommerfeld's server.el. Since then, a number of
+ − 62 ;; people have worked on it, including Bob Weiner, Darell Kindred,
+ − 63 ;; Arup Mukherjee, Ben Wing and Jan Vroonhof. It was completely
+ − 64 ;; rewritten (labeled as version 3) by Hrvoje Niksic in May 1997. The
+ − 65 ;; new code will not run on GNU Emacs.
+ − 66
+ − 67 ;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996
+ − 68 ;; ported the server-temp-file-regexp feature from server.el
+ − 69 ;; ported server hooks from server.el
+ − 70 ;; ported kill-*-query functions from server.el (and made it optional)
+ − 71 ;; synced other behavior with server.el
+ − 72 ;;
+ − 73 ;; Jan Vroonhof
+ − 74 ;; Customized.
+ − 75 ;;
+ − 76 ;; Hrvoje Niksic <hniksic@xemacs.org> May/1997
+ − 77 ;; Completely rewritten. Now uses `defstruct' and other CL stuff
+ − 78 ;; to define clients cleanly. Many thanks to Dave Gillespie!
+ − 79 ;;
+ − 80 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997
+ − 81 ;; Added 'Done' button to the menubar.
+ − 82
+ − 83
+ − 84 ;;; Code:
+ − 85
+ − 86 (defgroup gnuserv nil
+ − 87 "The gnuserv suite of programs to talk to Emacs from outside."
+ − 88 :group 'environment
+ − 89 :group 'processes
+ − 90 :group 'terminals)
+ − 91
710
+ − 92 ;;;###autoload
+ − 93 (defcustom gnuserv-mode-line-string " Server"
+ − 94 "*String to display in the modeline when Gnuserv is active.
+ − 95 Set this to nil if you don't want a modeline indicator."
+ − 96 :type '(choice string
+ − 97 (const :tag "none" nil))
+ − 98 :group 'gnuserv)
+ − 99
428
+ − 100
+ − 101 ;; Provide the old variables as aliases, to avoid breaking .emacs
+ − 102 ;; files. However, they are obsolete and should be converted to the
+ − 103 ;; new forms. This ugly crock must be before the variable
+ − 104 ;; declaration, or the scheme fails.
+ − 105
+ − 106 (define-obsolete-variable-alias 'server-frame 'gnuserv-frame)
+ − 107 (define-obsolete-variable-alias 'server-done-function
+ − 108 'gnuserv-done-function)
+ − 109 (define-obsolete-variable-alias 'server-done-temp-file-function
+ − 110 'gnuserv-done-temp-file-function)
+ − 111 (define-obsolete-variable-alias 'server-find-file-function
+ − 112 'gnuserv-find-file-function)
+ − 113 (define-obsolete-variable-alias 'server-program
+ − 114 'gnuserv-program)
+ − 115 (define-obsolete-variable-alias 'server-visit-hook
+ − 116 'gnuserv-visit-hook)
+ − 117 (define-obsolete-variable-alias 'server-done-hook
+ − 118 'gnuserv-done-hook)
+ − 119 (define-obsolete-variable-alias 'server-kill-quietly
+ − 120 'gnuserv-kill-quietly)
+ − 121 (define-obsolete-variable-alias 'server-temp-file-regexp
+ − 122 'gnuserv-temp-file-regexp)
+ − 123 (define-obsolete-variable-alias 'server-make-temp-file-backup
+ − 124 'gnuserv-make-temp-file-backup)
+ − 125
+ − 126 ;;;###autoload
+ − 127 (defcustom gnuserv-frame nil
+ − 128 "*The frame to be used to display all edited files.
+ − 129 If nil, then a new frame is created for each file edited.
+ − 130 If t, then the currently selected frame will be used.
+ − 131 If a function, then this will be called with a symbol `x' or `tty' as the
+ − 132 only argument, and its return value will be interpreted as above."
+ − 133 :tag "Gnuserv Frame"
+ − 134 :type '(radio (const :tag "Create new frame each time" nil)
+ − 135 (const :tag "Use selected frame" t)
+ − 136 (function-item :tag "Use main Emacs frame"
+ − 137 gnuserv-main-frame-function)
+ − 138 (function-item :tag "Use visible frame, otherwise create new"
+ − 139 gnuserv-visible-frame-function)
+ − 140 (function-item :tag "Create special Gnuserv frame and use it"
+ − 141 gnuserv-special-frame-function)
+ − 142 (function :tag "Other"))
+ − 143 :group 'gnuserv
+ − 144 :group 'frames)
+ − 145
+ − 146 (defcustom gnuserv-frame-plist nil
+ − 147 "*Plist of frame properties for creating a gnuserv frame."
+ − 148 :type 'plist
+ − 149 :group 'gnuserv
+ − 150 :group 'frames)
+ − 151
+ − 152 (defcustom gnuserv-done-function 'kill-buffer
+ − 153 "*Function used to remove a buffer after editing.
+ − 154 It is called with one BUFFER argument. Functions such as `kill-buffer' and
+ − 155 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
+ − 156 :type '(radio (function-item kill-buffer)
+ − 157 (function-item bury-buffer)
+ − 158 (function :tag "Other"))
+ − 159 :group 'gnuserv)
+ − 160
+ − 161 (defcustom gnuserv-done-temp-file-function 'kill-buffer
+ − 162 "*Function used to remove a temporary buffer after editing.
+ − 163 It is called with one BUFFER argument. Functions such as `kill-buffer' and
+ − 164 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
+ − 165 :type '(radio (function-item kill-buffer)
+ − 166 (function-item bury-buffer)
+ − 167 (function :tag "Other"))
+ − 168 :group 'gnuserv)
+ − 169
+ − 170 (defcustom gnuserv-find-file-function 'find-file
+ − 171 "*Function to visit a file with.
+ − 172 It takes one argument, a file name to visit."
+ − 173 :type 'function
+ − 174 :group 'gnuserv)
+ − 175
+ − 176 (defcustom gnuserv-view-file-function 'view-file
+ − 177 "*Function to view a file with.
+ − 178 It takes one argument, a file name to view."
+ − 179 :type '(radio (function-item view-file)
+ − 180 (function-item find-file-read-only)
+ − 181 (function :tag "Other"))
+ − 182 :group 'gnuserv)
+ − 183
+ − 184 (defcustom gnuserv-program "gnuserv"
+ − 185 "*Program to use as the editing server."
+ − 186 :type 'string
+ − 187 :group 'gnuserv)
+ − 188
+ − 189 (defcustom gnuserv-visit-hook nil
+ − 190 "*Hook run after visiting a file."
+ − 191 :type 'hook
+ − 192 :group 'gnuserv)
+ − 193
+ − 194 (defcustom gnuserv-done-hook nil
+ − 195 "*Hook run when done editing a buffer for the Emacs server.
+ − 196 The hook functions are called after the file has been visited, with the
+ − 197 current buffer set to the visiting buffer."
+ − 198 :type 'hook
+ − 199 :group 'gnuserv)
+ − 200
+ − 201 (defcustom gnuserv-init-hook nil
+ − 202 "*Hook run after the server is started."
+ − 203 :type 'hook
+ − 204 :group 'gnuserv)
+ − 205
+ − 206 (defcustom gnuserv-shutdown-hook nil
+ − 207 "*Hook run before the server exits."
+ − 208 :type 'hook
+ − 209 :group 'gnuserv)
+ − 210
+ − 211 (defcustom gnuserv-kill-quietly nil
+ − 212 "*Non-nil means to kill buffers with clients attached without requiring confirmation."
+ − 213 :type 'boolean
+ − 214 :group 'gnuserv)
+ − 215
+ − 216 (defcustom gnuserv-temp-file-regexp
+ − 217 (concat "^" (temp-directory) "/Re\\|/draft$")
+ − 218 "*Regexp which should match filenames of temporary files deleted
+ − 219 and reused by the programs that invoke the Emacs server."
+ − 220 :type 'regexp
+ − 221 :group 'gnuserv)
+ − 222
+ − 223 (defcustom gnuserv-make-temp-file-backup nil
+ − 224 "*Non-nil makes the server backup temporary files also."
+ − 225 :type 'boolean
+ − 226 :group 'gnuserv)
+ − 227
+ − 228
+ − 229 ;;; Internal variables:
+ − 230
+ − 231 (defstruct gnuclient
+ − 232 "An object that encompasses several buffers in one.
+ − 233 Normally, a client connecting to Emacs will be assigned an id, and
+ − 234 will request editing of several files.
+ − 235
+ − 236 ID - Client id (integer).
+ − 237 BUFFERS - List of buffers that \"belong\" to the client.
+ − 238 NOTE: one buffer can belong to several clients.
+ − 239 DEVICE - The device this client is on. If the device was also created.
+ − 240 by a client, it will be placed to `gnuserv-devices' list.
+ − 241 FRAME - Frame created by the client, or nil if the client didn't
+ − 242 create a frame.
+ − 243
+ − 244 All the slots default to nil."
+ − 245 (id nil)
+ − 246 (buffers nil)
+ − 247 (device nil)
+ − 248 (frame nil))
+ − 249
+ − 250 (defvar gnuserv-process nil
+ − 251 "The current gnuserv process.")
+ − 252
+ − 253 (defvar gnuserv-string ""
+ − 254 "The last input string from the server.")
+ − 255
+ − 256 (defvar gnuserv-current-client nil
+ − 257 "The client we are currently talking to.")
+ − 258
+ − 259 (defvar gnuserv-clients nil
+ − 260 "List of current gnuserv clients.
+ − 261 Each element is a gnuclient structure that identifies a client.")
+ − 262
+ − 263 (defvar gnuserv-devices nil
+ − 264 "List of devices created by clients.")
+ − 265
+ − 266 (defvar gnuserv-special-frame nil
+ − 267 "Frame created specially for Server.")
+ − 268
+ − 269 ;; We want the client-infested buffers to have some modeline
+ − 270 ;; identification, so we'll make a "minor mode".
+ − 271 (defvar gnuserv-minor-mode nil)
710
+ − 272 (make-variable-buffer-local 'gnuserv-minor-mode)
+ − 273 ;;(pushnew '(gnuserv-minor-mode "Server") minor-mode-alist
+ − 274 ;; :test 'equal)
+ − 275 (add-minor-mode 'gnuserv-minor-mode 'gnuserv-mode-line-string)
428
+ − 276
+ − 277
+ − 278 ;; Sample gnuserv-frame functions
+ − 279
+ − 280 (defun gnuserv-main-frame-function (type)
+ − 281 "Return a sensible value for the main Emacs frame."
+ − 282 (if (or (eq type 'x)
462
+ − 283 (eq type 'gtk)
428
+ − 284 (eq type 'mswindows))
+ − 285 (car (frame-list))
+ − 286 nil))
+ − 287
+ − 288 (defun gnuserv-visible-frame-function (type)
+ − 289 "Return a frame if there is a frame that is truly visible, nil otherwise.
+ − 290 This is meant in the X sense, so it will not return frames that are on another
+ − 291 visual screen. Totally visible frames are preferred. If none found, return nil."
+ − 292 (if (or (eq type 'x)
462
+ − 293 (eq type 'gtk)
428
+ − 294 (eq type 'mswindows))
+ − 295 (cond ((car (filtered-frame-list 'frame-totally-visible-p
+ − 296 (selected-device))))
+ − 297 ((car (filtered-frame-list (lambda (frame)
+ − 298 ;; eq t as in not 'hidden
+ − 299 (eq t (frame-visible-p frame)))
+ − 300 (selected-device)))))
+ − 301 nil))
+ − 302
+ − 303 (defun gnuserv-special-frame-function (type)
+ − 304 "Create a special frame for Gnuserv and return it on later invocations."
+ − 305 (unless (frame-live-p gnuserv-special-frame)
+ − 306 (setq gnuserv-special-frame (make-frame gnuserv-frame-plist)))
+ − 307 gnuserv-special-frame)
+ − 308
+ − 309
+ − 310 ;;; Communication functions
+ − 311
+ − 312 ;; We used to restart the server here, but it's too risky -- if
+ − 313 ;; something goes awry, it's too easy to wind up in a loop.
+ − 314 (defun gnuserv-sentinel (proc msg)
+ − 315 (let ((msgstring (concat "Gnuserv process %s; restart with `%s'"))
+ − 316 (keystring (substitute-command-keys "\\[gnuserv-start]")))
+ − 317 (case (process-status proc)
+ − 318 (exit
+ − 319 (message msgstring "exited" keystring)
+ − 320 (gnuserv-prepare-shutdown))
+ − 321 (signal
+ − 322 (message msgstring "killed" keystring)
+ − 323 (gnuserv-prepare-shutdown))
+ − 324 (closed
+ − 325 (message msgstring "closed" keystring))
+ − 326 (gnuserv-prepare-shutdown))))
+ − 327
+ − 328 ;; This function reads client requests from our current server. Every
+ − 329 ;; client is identified by a unique ID within the server
+ − 330 ;; (incidentally, the same ID is the file descriptor the server uses
+ − 331 ;; to communicate to client).
+ − 332 ;;
+ − 333 ;; The request string can arrive in several chunks. As the request
+ − 334 ;; ends with \C-d, we check for that character at the end of string.
+ − 335 ;; If not found, keep reading, and concatenating to former strings.
+ − 336 ;; So, if at first read we receive "5 (gn", that text will be stored
+ − 337 ;; to gnuserv-string. If we then receive "us)\C-d", the two will be
+ − 338 ;; concatenated, `current-client' will be set to 5, and `(gnus)' form
+ − 339 ;; will be evaluated.
+ − 340 ;;
+ − 341 ;; Server will send the following:
+ − 342 ;;
+ − 343 ;; "ID <text>\C-d" (no quotes)
+ − 344 ;;
+ − 345 ;; ID - file descriptor of the given client;
+ − 346 ;; <text> - the actual contents of the request.
+ − 347 (defun gnuserv-process-filter (proc string)
+ − 348 "Process gnuserv client requests to execute Emacs commands."
+ − 349 (setq gnuserv-string (concat gnuserv-string string))
+ − 350 ;; C-d means end of request.
456
+ − 351 (when (string-match "\C-d\n?\\'" gnuserv-string)
+ − 352 (cond ((string-match "\\`[0-9]+" gnuserv-string) ; client request id
428
+ − 353 (let ((header (read-from-string gnuserv-string)))
+ − 354 ;; Set the client we are talking to.
+ − 355 (setq gnuserv-current-client (car header))
+ − 356 ;; Evaluate the expression
+ − 357 (condition-case oops
+ − 358 (eval (car (read-from-string gnuserv-string (cdr header))))
+ − 359 ;; In case of an error, write the description to the
+ − 360 ;; client, and then signal it.
+ − 361 (error (setq gnuserv-string "")
434
+ − 362 (when gnuserv-current-client
+ − 363 (gnuserv-write-to-client gnuserv-current-client oops))
428
+ − 364 (setq gnuserv-current-client nil)
+ − 365 (signal (car oops) (cdr oops)))
+ − 366 (quit (setq gnuserv-string "")
434
+ − 367 (when gnuserv-current-client
+ − 368 (gnuserv-write-to-client gnuserv-current-client oops))
428
+ − 369 (setq gnuserv-current-client nil)
+ − 370 (signal 'quit nil)))
+ − 371 (setq gnuserv-string "")))
+ − 372 (t
456
+ − 373 (let ((response (car (split-string gnuserv-string "\C-d"))))
+ − 374 (setq gnuserv-string "")
+ − 375 (error "%s: invalid response from gnuserv" response))))))
428
+ − 376
+ − 377 ;; This function is somewhat of a misnomer. Actually, we write to the
+ − 378 ;; server (using `process-send-string' to gnuserv-process), which
+ − 379 ;; interprets what we say and forwards it to the client. The
+ − 380 ;; incantation server understands is (from gnuserv.c):
+ − 381 ;;
+ − 382 ;; "FD/LEN:<text>\n" (no quotes)
+ − 383 ;; FD - file descriptor of the given client (which we obtained from
+ − 384 ;; the server earlier);
+ − 385 ;; LEN - length of the stuff we are about to send;
+ − 386 ;; <text> - the actual contents of the request.
+ − 387 (defun gnuserv-write-to-client (client-id form)
+ − 388 "Write the given form to the given client via the gnuserv process."
+ − 389 (when (eq (process-status gnuserv-process) 'run)
+ − 390 (let* ((result (format "%s" form))
+ − 391 (s (format "%s/%d:%s\n" client-id
+ − 392 (length result) result)))
+ − 393 (process-send-string gnuserv-process s))))
+ − 394
+ − 395 ;; The following two functions are helper functions, used by
+ − 396 ;; gnuclient.
+ − 397
+ − 398 (defun gnuserv-eval (form)
+ − 399 "Evaluate form and return result to client."
+ − 400 (gnuserv-write-to-client gnuserv-current-client (eval form))
+ − 401 (setq gnuserv-current-client nil))
+ − 402
+ − 403 (defun gnuserv-eval-quickly (form)
+ − 404 "Let client know that we've received the request, and then eval the form.
+ − 405 This order is important as not to keep the client waiting."
+ − 406 (gnuserv-write-to-client gnuserv-current-client nil)
+ − 407 (setq gnuserv-current-client nil)
+ − 408 (eval form))
+ − 409
+ − 410
+ − 411 ;; "Execute" a client connection, called by gnuclient. This is the
+ − 412 ;; backbone of gnuserv.el.
+ − 413 (defun gnuserv-edit-files (type list &rest flags)
+ − 414 "For each (line-number . file) pair in LIST, edit the file at line-number.
+ − 415 The visited buffers are memorized, so that when \\[gnuserv-edit] is invoked
+ − 416 in such a buffer, or when it is killed, or the client's device deleted, the
+ − 417 client will be invoked that the edit is finished.
+ − 418
+ − 419 TYPE should either be a (tty TTY TERM PID) list, or (x DISPLAY) list.
+ − 420 If a flag is `quick', just edit the files in Emacs.
+ − 421 If a flag is `view', view the files read-only."
+ − 422 (let (quick view)
+ − 423 (mapc (lambda (flag)
+ − 424 (case flag
+ − 425 (quick (setq quick t))
+ − 426 (view (setq view t))
+ − 427 (t (error "Invalid flag %s" flag))))
+ − 428 flags)
+ − 429 (let* ((old-device-num (length (device-list)))
+ − 430 (new-frame nil)
+ − 431 (dest-frame (if (functionp gnuserv-frame)
+ − 432 (funcall gnuserv-frame (car type))
+ − 433 gnuserv-frame))
+ − 434 ;; The gnuserv-frame dependencies are ugly, but it's
+ − 435 ;; extremely hard to make that stuff cleaner without
+ − 436 ;; breaking everything in sight.
+ − 437 (device (cond ((frame-live-p dest-frame)
+ − 438 (frame-device dest-frame))
+ − 439 ((null dest-frame)
+ − 440 (case (car type)
+ − 441 (tty (apply 'make-tty-device (cdr type)))
462
+ − 442 (gtk (make-gtk-device))
428
+ − 443 (x (make-x-device (cadr type)))
+ − 444 (mswindows (make-mswindows-device))
+ − 445 (t (error "Invalid device type"))))
+ − 446 (t
+ − 447 (selected-device))))
+ − 448 (frame (cond ((frame-live-p dest-frame)
+ − 449 dest-frame)
+ − 450 ((null dest-frame)
+ − 451 (setq new-frame (make-frame gnuserv-frame-plist
+ − 452 device))
+ − 453 new-frame)
+ − 454 (t (selected-frame))))
+ − 455 (client (make-gnuclient :id gnuserv-current-client
+ − 456 :device device
+ − 457 :frame new-frame)))
+ − 458 (select-frame frame)
+ − 459 (setq gnuserv-current-client nil)
+ − 460 ;; If the device was created by this client, push it to the list.
+ − 461 (and (/= old-device-num (length (device-list)))
+ − 462 (push device gnuserv-devices))
+ − 463 (and (frame-iconified-p frame)
+ − 464 (deiconify-frame frame))
+ − 465 ;; Visit all the listed files.
+ − 466 (while list
+ − 467 (let ((line (caar list)) (path (cdar list)))
+ − 468 (select-frame frame)
+ − 469 ;; Visit the file.
+ − 470 (funcall (if view
+ − 471 gnuserv-view-file-function
+ − 472 gnuserv-find-file-function)
+ − 473 path)
+ − 474 (goto-line line)
+ − 475 ;; Don't memorize the quick and view buffers.
+ − 476 (unless (or quick view)
+ − 477 (pushnew (current-buffer) (gnuclient-buffers client))
+ − 478 (setq gnuserv-minor-mode t)
+ − 479 ;; Add the "Done" button to the menubar, only in this buffer.
+ − 480 (if (and (featurep 'menubar) current-menubar)
+ − 481 (progn (set-buffer-menubar current-menubar)
+ − 482 (add-menu-button nil ["Done" gnuserv-edit]))
+ − 483 ))
+ − 484 (run-hooks 'gnuserv-visit-hook)
+ − 485 (pop list)))
+ − 486 (cond
+ − 487 ((and (or quick view)
+ − 488 (device-on-window-system-p device))
+ − 489 ;; Exit if on X device, and quick or view. NOTE: if the
+ − 490 ;; client is to finish now, it must absolutely /not/ be
+ − 491 ;; included to the list of clients. This way the client-ids
+ − 492 ;; should be unique.
+ − 493 (gnuserv-write-to-client (gnuclient-id client) nil))
+ − 494 (t
+ − 495 ;; Else, the client gets a vote.
+ − 496 (push client gnuserv-clients)
+ − 497 ;; Explain buffer exit options. If dest-frame is nil, the
+ − 498 ;; user can exit via `delete-frame'. OTOH, if FLAGS are nil
+ − 499 ;; and there are some buffers, the user can exit via
+ − 500 ;; `gnuserv-edit'.
+ − 501 (if (and (not (or quick view))
+ − 502 (gnuclient-buffers client))
+ − 503 (message "%s"
+ − 504 (substitute-command-keys
+ − 505 "Type `\\[gnuserv-edit]' to finish editing"))
+ − 506 (or dest-frame
+ − 507 (message "%s"
+ − 508 (substitute-command-keys
+ − 509 "Type `\\[delete-frame]' to finish editing")))))))))
+ − 510
+ − 511
+ − 512 ;;; Functions that hook into Emacs in various way to enable operation
+ − 513
+ − 514 ;; Defined later.
+ − 515 (add-hook 'kill-emacs-hook 'gnuserv-kill-all-clients t)
+ − 516
+ − 517 ;; A helper function; used by others. Try avoiding it whenever
+ − 518 ;; possible, because it is slow, and conses a list. Use
+ − 519 ;; `gnuserv-buffer-p' when appropriate, for instance.
+ − 520 (defun gnuserv-buffer-clients (buffer)
+ − 521 "Return a list of clients to which BUFFER belongs."
+ − 522 (let (res)
+ − 523 (dolist (client gnuserv-clients)
+ − 524 (when (memq buffer (gnuclient-buffers client))
+ − 525 (push client res)))
+ − 526 res))
+ − 527
+ − 528 ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't
+ − 529 ;; collect a list.
+ − 530 (defun gnuserv-buffer-p (buffer)
+ − 531 (member* buffer gnuserv-clients
+ − 532 :test 'memq
+ − 533 :key 'gnuclient-buffers))
+ − 534
+ − 535 ;; This function makes sure that a killed buffer is deleted off the
+ − 536 ;; list for the particular client.
+ − 537 ;;
+ − 538 ;; This hooks into `kill-buffer-hook'. It is *not* a replacement for
+ − 539 ;; `kill-buffer' (thanks God).
+ − 540 (defun gnuserv-kill-buffer-function ()
+ − 541 "Remove the buffer from the buffer lists of all the clients it belongs to.
+ − 542 Any client that remains \"empty\" after the removal is informed that the
+ − 543 editing has ended."
+ − 544 (let* ((buf (current-buffer)))
+ − 545 (dolist (client (gnuserv-buffer-clients buf))
+ − 546 (callf2 delq buf (gnuclient-buffers client))
+ − 547 ;; If no more buffers, kill the client.
+ − 548 (when (null (gnuclient-buffers client))
+ − 549 (gnuserv-kill-client client)))))
+ − 550
+ − 551 (add-hook 'kill-buffer-hook 'gnuserv-kill-buffer-function)
+ − 552
+ − 553 ;; Ask for confirmation before killing a buffer that belongs to a
+ − 554 ;; living client.
+ − 555 (defun gnuserv-kill-buffer-query-function ()
+ − 556 (or gnuserv-kill-quietly
+ − 557 (not (gnuserv-buffer-p (current-buffer)))
+ − 558 (yes-or-no-p
+ − 559 (format "Buffer %s belongs to gnuserv client(s); kill anyway? "
+ − 560 (current-buffer)))))
+ − 561
+ − 562 (add-hook 'kill-buffer-query-functions
+ − 563 'gnuserv-kill-buffer-query-function)
+ − 564
+ − 565 (defun gnuserv-kill-emacs-query-function ()
+ − 566 (or gnuserv-kill-quietly
+ − 567 (not (some 'gnuclient-buffers gnuserv-clients))
+ − 568 (yes-or-no-p "Gnuserv buffers still have clients; exit anyway? ")))
+ − 569
+ − 570 (add-hook 'kill-emacs-query-functions
+ − 571 'gnuserv-kill-emacs-query-function)
+ − 572
+ − 573 ;; If the device of a client is to be deleted, the client should die
+ − 574 ;; as well. This is why we hook into `delete-device-hook'.
+ − 575 (defun gnuserv-check-device (device)
+ − 576 (when (memq device gnuserv-devices)
+ − 577 (dolist (client gnuserv-clients)
+ − 578 (when (eq device (gnuclient-device client))
+ − 579 ;; we must make sure that the server kill doesn't result in
+ − 580 ;; killing the device, because it would cause a device-dead
+ − 581 ;; error when `delete-device' tries to do the job later.
+ − 582 (gnuserv-kill-client client t))))
+ − 583 (callf2 delq device gnuserv-devices))
+ − 584
+ − 585 (add-hook 'delete-device-hook 'gnuserv-check-device)
+ − 586
+ − 587 (defun gnuserv-temp-file-p (buffer)
+ − 588 "Return non-nil if BUFFER contains a file considered temporary.
+ − 589 These are files whose names suggest they are repeatedly
+ − 590 reused to pass information to another program.
+ − 591
+ − 592 The variable `gnuserv-temp-file-regexp' controls which filenames
+ − 593 are considered temporary."
+ − 594 (and (buffer-file-name buffer)
+ − 595 (string-match gnuserv-temp-file-regexp (buffer-file-name buffer))))
+ − 596
+ − 597 (defun gnuserv-kill-client (client &optional leave-frame)
+ − 598 "Kill the gnuclient CLIENT.
+ − 599 This will do away with all the associated buffers. If LEAVE-FRAME,
+ − 600 the function will not remove the frames associated with the client."
+ − 601 ;; Order is important: first delete client from gnuserv-clients, to
+ − 602 ;; prevent gnuserv-buffer-done-1 calling us recursively.
+ − 603 (callf2 delq client gnuserv-clients)
+ − 604 ;; Process the buffers.
+ − 605 (mapc 'gnuserv-buffer-done-1 (gnuclient-buffers client))
+ − 606 (unless leave-frame
+ − 607 (let ((device (gnuclient-device client)))
+ − 608 ;; kill frame created by this client (if any), unless
+ − 609 ;; specifically requested otherwise.
+ − 610 ;;
+ − 611 ;; note: last frame on a device will not be deleted here.
+ − 612 (when (and (gnuclient-frame client)
+ − 613 (frame-live-p (gnuclient-frame client))
+ − 614 (second (device-frame-list device)))
+ − 615 (delete-frame (gnuclient-frame client)))
+ − 616 ;; If the device is live, created by a client, and no longer used
+ − 617 ;; by any client, delete it.
+ − 618 (when (and (device-live-p device)
+ − 619 (memq device gnuserv-devices)
+ − 620 (second (device-list))
+ − 621 (not (member* device gnuserv-clients
+ − 622 :key 'gnuclient-device)))
+ − 623 ;; `gnuserv-check-device' will remove it from `gnuserv-devices'.
+ − 624 (delete-device device))))
+ − 625 ;; Notify the client.
+ − 626 (gnuserv-write-to-client (gnuclient-id client) nil))
+ − 627
+ − 628 ;; Do away with the buffer.
+ − 629 (defun gnuserv-buffer-done-1 (buffer)
+ − 630 (dolist (client (gnuserv-buffer-clients buffer))
+ − 631 (callf2 delq buffer (gnuclient-buffers client))
+ − 632 (when (null (gnuclient-buffers client))
+ − 633 (gnuserv-kill-client client)))
+ − 634 ;; Get rid of the buffer.
+ − 635 (save-excursion
+ − 636 (set-buffer buffer)
+ − 637 (run-hooks 'gnuserv-done-hook)
+ − 638 (setq gnuserv-minor-mode nil)
+ − 639 ;; Delete the menu button.
+ − 640 (if (and (featurep 'menubar) current-menubar)
+ − 641 (delete-menu-item '("Done")))
+ − 642 (funcall (if (gnuserv-temp-file-p buffer)
+ − 643 gnuserv-done-temp-file-function
+ − 644 gnuserv-done-function)
+ − 645 buffer)))
+ − 646
+ − 647
+ − 648 ;;; Higher-level functions
+ − 649
+ − 650 ;; Choose a `next' server buffer, according to several criteria, and
+ − 651 ;; return it. If none are found, return nil.
+ − 652 (defun gnuserv-next-buffer ()
+ − 653 (let* ((frame (selected-frame))
+ − 654 (device (selected-device))
+ − 655 client)
+ − 656 (cond
+ − 657 ;; If we have a client belonging to this frame, return
+ − 658 ;; the first buffer from it.
+ − 659 ((setq client
+ − 660 (car (member* frame gnuserv-clients :key 'gnuclient-frame)))
+ − 661 (car (gnuclient-buffers client)))
+ − 662 ;; Else, look for a device.
+ − 663 ((and
+ − 664 (memq (selected-device) gnuserv-devices)
+ − 665 (setq client
+ − 666 (car (member* device gnuserv-clients :key 'gnuclient-device))))
+ − 667 (car (gnuclient-buffers client)))
+ − 668 ;; Else, try to find any client with at least one buffer, and
+ − 669 ;; return its first buffer.
+ − 670 ((setq client
+ − 671 (car (member-if-not #'null gnuserv-clients
+ − 672 :key 'gnuclient-buffers)))
+ − 673 (car (gnuclient-buffers client)))
+ − 674 ;; Oh, give up.
+ − 675 (t nil))))
+ − 676
+ − 677 (defun gnuserv-buffer-done (buffer)
+ − 678 "Mark BUFFER as \"done\" for its client(s).
+ − 679 Does the save/backup queries first, and calls `gnuserv-done-function'."
+ − 680 ;; Check whether this is the real thing.
+ − 681 (unless (gnuserv-buffer-p buffer)
+ − 682 (error "%s does not belong to a gnuserv client" buffer))
+ − 683 ;; Backup/ask query.
+ − 684 (if (gnuserv-temp-file-p buffer)
+ − 685 ;; For a temp file, save, and do NOT make a non-numeric backup
+ − 686 ;; Why does server.el explicitly back up temporary files?
+ − 687 (let ((version-control nil)
+ − 688 (buffer-backed-up (not gnuserv-make-temp-file-backup)))
+ − 689 (save-buffer))
+ − 690 (if (and (buffer-modified-p)
+ − 691 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
+ − 692 (save-buffer buffer)))
+ − 693 (gnuserv-buffer-done-1 buffer))
+ − 694
+ − 695 ;; Called by `gnuserv-start-1' to clean everything. Hooked into
+ − 696 ;; `kill-emacs-hook', too.
+ − 697 (defun gnuserv-kill-all-clients ()
+ − 698 "Kill all the gnuserv clients. Ruthlessly."
+ − 699 (mapc 'gnuserv-kill-client gnuserv-clients))
+ − 700
+ − 701 ;; This serves to run the hook and reset
+ − 702 ;; `allow-deletion-of-last-visible-frame'.
+ − 703 (defun gnuserv-prepare-shutdown ()
+ − 704 (setq allow-deletion-of-last-visible-frame nil)
+ − 705 (run-hooks 'gnuserv-shutdown-hook))
+ − 706
+ − 707 ;; This is a user-callable function, too.
+ − 708 (defun gnuserv-shutdown ()
+ − 709 "Shutdown the gnuserv server, if one is currently running.
+ − 710 All the clients will be disposed of via the normal methods."
+ − 711 (interactive)
+ − 712 (gnuserv-kill-all-clients)
+ − 713 (when gnuserv-process
+ − 714 (set-process-sentinel gnuserv-process nil)
+ − 715 (gnuserv-prepare-shutdown)
+ − 716 (condition-case ()
+ − 717 (delete-process gnuserv-process)
+ − 718 (error nil))
+ − 719 (setq gnuserv-process nil)))
+ − 720
+ − 721 ;; Actually start the process. Kills all the clients before-hand.
+ − 722 (defun gnuserv-start-1 (&optional leave-dead)
+ − 723 ;; Shutdown the existing server, if any.
+ − 724 (gnuserv-shutdown)
+ − 725 ;; If we already had a server, clear out associated status.
+ − 726 (unless leave-dead
+ − 727 (setq gnuserv-string ""
+ − 728 gnuserv-current-client nil)
+ − 729 (let ((process-connection-type t))
+ − 730 (setq gnuserv-process
+ − 731 (start-process "gnuserv" nil gnuserv-program)))
+ − 732 (set-process-sentinel gnuserv-process 'gnuserv-sentinel)
+ − 733 (set-process-filter gnuserv-process 'gnuserv-process-filter)
+ − 734 (process-kill-without-query gnuserv-process)
+ − 735 (setq allow-deletion-of-last-visible-frame t)
+ − 736 (run-hooks 'gnuserv-init-hook)))
+ − 737
+ − 738
+ − 739 ;;; User-callable functions:
+ − 740
+ − 741 ;;;###autoload
+ − 742 (defun gnuserv-running-p ()
+ − 743 "Return non-nil if a gnuserv process is running from this XEmacs session."
+ − 744 (not (not gnuserv-process)))
+ − 745
+ − 746 ;;;###autoload
+ − 747 (defun gnuserv-start (&optional leave-dead)
+ − 748 "Allow this Emacs process to be a server for client processes.
+ − 749 This starts a gnuserv communications subprocess through which
+ − 750 client \"editors\" (gnuclient and gnudoit) can send editing commands to
+ − 751 this Emacs job. See the gnuserv(1) manual page for more details.
+ − 752
+ − 753 Prefix arg means just kill any existing server communications subprocess."
+ − 754 (interactive "P")
+ − 755 (and gnuserv-process
+ − 756 (not leave-dead)
+ − 757 (message "Restarting gnuserv"))
+ − 758 (gnuserv-start-1 leave-dead))
+ − 759
+ − 760 (defun gnuserv-edit (&optional count)
+ − 761 "Mark the current gnuserv editing buffer as \"done\", and switch to next one.
+ − 762
+ − 763 Run with a numeric prefix argument, repeat the operation that number
+ − 764 of times. If given a universal prefix argument, close all the buffers
+ − 765 of this buffer's clients.
+ − 766
+ − 767 The `gnuserv-done-function' (bound to `kill-buffer' by default) is
+ − 768 called to dispose of the buffer after marking it as done.
+ − 769
+ − 770 Files that match `gnuserv-temp-file-regexp' are considered temporary and
+ − 771 are saved unconditionally and backed up if `gnuserv-make-temp-file-backup'
+ − 772 is non-nil. They are disposed of using `gnuserv-done-temp-file-function'
+ − 773 \(also bound to `kill-buffer' by default).
+ − 774
+ − 775 When all of a client's buffers are marked as \"done\", the client is notified."
+ − 776 (interactive "P")
+ − 777 (when (null count)
+ − 778 (setq count 1))
+ − 779 (cond ((numberp count)
+ − 780 (while (natnump (decf count))
+ − 781 (let ((frame (selected-frame)))
+ − 782 (gnuserv-buffer-done (current-buffer))
+ − 783 (when (eq frame (selected-frame))
+ − 784 ;; Switch to the next gnuserv buffer. However, do this
+ − 785 ;; only if we remain in the same frame.
+ − 786 (let ((next (gnuserv-next-buffer)))
+ − 787 (when next
+ − 788 (switch-to-buffer next)))))))
+ − 789 (count
+ − 790 (let* ((buf (current-buffer))
+ − 791 (clients (gnuserv-buffer-clients buf)))
+ − 792 (unless clients
+ − 793 (error "%s does not belong to a gnuserv client" buf))
+ − 794 (mapc 'gnuserv-kill-client (gnuserv-buffer-clients buf))))))
+ − 795
+ − 796 (global-set-key "\C-x#" 'gnuserv-edit)
+ − 797
+ − 798 (provide 'gnuserv)
+ − 799
+ − 800 ;;; gnuserv.el ends here
