X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnuserv.el;h=238948072f3fe57cdbd127814895da9d58830e1a;hb=fe7ecc7fb1337725a1ae788ddcab0784abd13178;hp=8da403ca5f9c1a023e8e43761fc0702ed093a355;hpb=afa9772e3fcbb4e80e3e4cfd1a40b4fccc6d08b8;p=chise%2Fxemacs-chise.git- diff --git a/lisp/gnuserv.el b/lisp/gnuserv.el index 8da403c..2389480 100644 --- a/lisp/gnuserv.el +++ b/lisp/gnuserv.el @@ -1,7 +1,7 @@ ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv ;; Copyright (C) 1989-1997 Free Software Foundation, Inc. -;; Version: 3.11 +;; Version: 3.12 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el ;; Hrvoje Niksic ;; Maintainer: Jan Vroonhof , @@ -271,6 +271,7 @@ Each element is a gnuclient structure that identifies a client.") (defun gnuserv-main-frame-function (type) "Return a sensible value for the main Emacs frame." (if (or (eq type 'x) + (eq type 'gtk) (eq type 'mswindows)) (car (frame-list)) nil)) @@ -280,6 +281,7 @@ Each element is a gnuclient structure that identifies a client.") This is meant in the X sense, so it will not return frames that are on another visual screen. Totally visible frames are preferred. If none found, return nil." (if (or (eq type 'x) + (eq type 'gtk) (eq type 'mswindows)) (cond ((car (filtered-frame-list 'frame-totally-visible-p (selected-device)))) @@ -337,8 +339,8 @@ visual screen. Totally visible frames are preferred. If none found, return nil "Process gnuserv client requests to execute Emacs commands." (setq gnuserv-string (concat gnuserv-string string)) ;; C-d means end of request. - (when (string-match "\C-d\\'" gnuserv-string) - (cond ((string-match "^[0-9]+" gnuserv-string) ; client request id + (when (string-match "\C-d\n?\\'" gnuserv-string) + (cond ((string-match "\\`[0-9]+" gnuserv-string) ; client request id (let ((header (read-from-string gnuserv-string))) ;; Set the client we are talking to. (setq gnuserv-current-client (car header)) @@ -348,17 +350,20 @@ visual screen. Totally visible frames are preferred. If none found, return nil ;; In case of an error, write the description to the ;; client, and then signal it. (error (setq gnuserv-string "") - (gnuserv-write-to-client gnuserv-current-client oops) + (when gnuserv-current-client + (gnuserv-write-to-client gnuserv-current-client oops)) (setq gnuserv-current-client nil) (signal (car oops) (cdr oops))) (quit (setq gnuserv-string "") - (gnuserv-write-to-client gnuserv-current-client oops) + (when gnuserv-current-client + (gnuserv-write-to-client gnuserv-current-client oops)) (setq gnuserv-current-client nil) (signal 'quit nil))) (setq gnuserv-string ""))) (t - (error "%s: invalid response from gnuserv" gnuserv-string) - (setq gnuserv-string ""))))) + (let ((response (car (split-string gnuserv-string "\C-d")))) + (setq gnuserv-string "") + (error "%s: invalid response from gnuserv" response)))))) ;; This function is somewhat of a misnomer. Actually, we write to the ;; server (using `process-send-string' to gnuserv-process), which @@ -425,6 +430,7 @@ If a flag is `view', view the files read-only." ((null dest-frame) (case (car type) (tty (apply 'make-tty-device (cdr type))) + (gtk (make-gtk-device)) (x (make-x-device (cadr type))) (mswindows (make-mswindows-device)) (t (error "Invalid device type"))))