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