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