xemacs-beta: lisp/packages/gnuserv.el comparison

comparison lisp/packages/gnuserv.el @ 193:f53b5ca2e663 r20-3b23

Import from CVS: tag r20-3b23

author	cvs
date	Mon, 13 Aug 2007 09:58:30 +0200
parents	e121b013d1f0
children	a2f645c6b9f8

comparison

equal deleted inserted replaced

-:9d35321dd38c
+:f53b5ca2e663
 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv
 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc.
-;; Version: 3.9
+;; Version: 3.10
 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el
-;;         Hrvoje Niksic <hniksic@srce.hr>
+;;         Hrvoje Niksic <hniksic@srce.hr>, rewritten from scratch in May 1997
 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>,
 ;;             Hrvoje Niksic <hniksic@srce.hr>
 ;; Keywords: environment, processes, terminals
 ;; This file is part of XEmacs.
 ;; ver William Sommerfeld's server.el.  Since then, a number of people
 ;; have worked on it, including Bob Weiner, Darell Kindred, Arup
 ;; Mukherjee, Ben Wing and Jan Vroonhof.  It was completely rewritten
 ;; (labeled as version 3) by Hrvoje Niksic in May 1997.
-;; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996
-;; ported the server-temp-file-regexp feature from server.el
-;; ported server hooks from server.el
-;; ported kill-*-query functions from server.el (and made it optional)
-;; synced other behaviour with server.el
-;;
 ;; Jan Vroonhof
 ;;     Customized.
 ;;
 ;; Hrvoje Niksic <hniksic@srce.hr> May/1997
 ;;     Completely rewritten.  Now uses `defstruct' and other CL stuff
 ;;     to define clients cleanly.  Many thanks to Dave Gillespie!
 ;;
 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997
 ;;     Added 'Done' button to the menubar.
+;;
+;; Hrvoje Niksic <hniksic@srce.hr> Sep/1997
+;;     More pervasive changes.
 ;;; Code:
 (defgroup gnuserv nil
 ;; Provide the old variables as aliases, to avoid breaking .emacs
 ;; files.  However, they are obsolete and should be converted to the
 ;; new forms.  This ugly crock must be before the variable
-;; declaration, or the scheme fails.
+;; declaration, or the scheme fails.  I'd prefer if we could junk this
+;; sh*t, but I guess the users will appreciate compatibility.  Uh...
 (define-obsolete-variable-alias 'server-frame 'gnuserv-frame)
 (define-obsolete-variable-alias 'server-done-function
 'gnuserv-done-function)
 (define-obsolete-variable-alias 'server-done-temp-file-function
 'gnuserv-visit-hook)
 (define-obsolete-variable-alias 'server-done-hook
 'gnuserv-done-hook)
 (define-obsolete-variable-alias 'server-kill-quietly
 'gnuserv-kill-quietly)
-(define-obsolete-variable-alias 'server-temp-file-regexp
-'gnuserv-temp-file-regexp)
-(define-obsolete-variable-alias 'server-make-temp-file-backup
-'gnuserv-make-temp-file-backup)
 ;;;###autoload
-(defcustom gnuserv-frame nil
+(defcustom gnuserv-frame 'new
-"*The frame to be used to display all edited files.
+"*Determines what frame will be used to display all edited files.
-If nil, then a new frame is created for each file edited.
+Legal values are:
-If t, then the currently selected frame will be used.
+`new'     -- a new frame will be created for each file edited;
-If a function, then this will be called with a symbol `x' or `tty' as the
+`current' -- the currently selected frame will be used;
-only argument, and its return value will be interpreted as above."
+`main'    -- \"main\" Emacs frame will be used;
+`visible' -- a visible frame will be used, or a new one created;
+`special' -- a special Gnuserv frame will be created, and used for
+all gnuserv-edited files;
+frame     -- that particular frame will be used.
+If gnuclient is called using the `-nw' method (from a TTY device), the
+behaviour will be as if gnuserv-frame were `new'.
+This variable is read by `gnuserv-frame-default-function'.  If you
+change `gnuserv-frame-function' to anything else, this variable will
+have no effect."
 :tag "Gnuserv Frame"
-:type '(radio (const :tag "Create new frame each time" nil)
+;; Compatibility
-		(const :tag "Use selected frame" t)
+:type '(radio (const :tag "Create new frame each time" new)
-	        (function-item :tag "Use main Emacs frame"
+		(const :tag "Use currently selected frame" current)
-			       gnuserv-main-frame-function)
+		(const :tag "Use main Emacs frame" main)
-		(function-item :tag "Use visible frame, otherwise create new"
+		(const :tag "Use visible frame, otherwise create new" visible)
-			       gnuserv-visible-frame-function)
+		(const :tag "Create special Gnuserv frame and use it" special))
-		(function-item :tag "Create special Gnuserv frame and use it"
+:group 'gnuserv)
-			       gnuserv-special-frame-function)
-		(function :tag "Other"))
+(defcustom gnuserv-frame-properties nil
-:group 'gnuserv)
+"*Properties of the frame in which gnuclient buffers are displayed.
+Note that this is in effect only for frames created by
+`gnuserv-frame-default-function'."
+:type '(repeat (group :inline t
+			(symbol :tag "Property")
+			(sexp :tag "Value")))
+:group 'gnuserv)
+(defcustom gnuserv-frame-function 'gnuserv-frame-default-function
+"*Function to return the appropriate frame for use by gnuclient.
+The function will be called with two arguments: the first one as
+described by `gnuserv-frame', and the second one as the device to
+create the frame on.
+The function must return a valid frame object."
+:type 'function
+:group 'gnuserv)
 (defcustom gnuserv-done-function 'kill-buffer
 "*Function used to remove a buffer after editing.
 It is called with one BUFFER argument.  Functions such as `kill-buffer' and
 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
 :type '(radio (function-item kill-buffer)
 		(function-item bury-buffer)
 		(function :tag "Other"))
 :group 'gnuserv)
-(defcustom gnuserv-done-temp-file-function 'kill-buffer
-"*Function used to remove a temporary buffer after editing.
-It is called with one BUFFER argument.  Functions such as `kill-buffer' and
-`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
-:type '(radio (function-item kill-buffer)
-		(function-item bury-buffer)
-		(function :tag "Other"))
-:group 'gnuserv)
 (defcustom gnuserv-find-file-function 'find-file
 "*Function to visit a file with.
 It takes one argument, a file name to visit."
 :type 'function
 :group 'gnuserv)
 :type 'hook
 :group 'gnuserv)
 (defcustom gnuserv-kill-quietly nil
 "*Non-nil means to kill buffers with clients attached without requiring confirmation."
-:type 'boolean
-:group 'gnuserv)
-(defcustom gnuserv-temp-file-regexp "^/tmp/Re\\|/draft$"
-"*Regexp which should match filenames of temporary files deleted
-and reused by the programs that invoke the Emacs server."
-:type 'regexp
-:group 'gnuserv)
-(defcustom gnuserv-make-temp-file-backup nil
-"*Non-nil makes the server backup temporary files also."
 :type 'boolean
 :group 'gnuserv)
 ;;; Internal variables:
 (id nil)
 (buffers nil)
 (device nil)
 (frame nil))
 (defvar gnuserv-process nil
 "The current gnuserv process.")
 (defvar gnuserv-string ""
 "The last input string from the server.")
 Each element is a gnuclient structure that identifies a client.")
 (defvar gnuserv-devices nil
 "List of devices created by clients.")
+;; We want the client-infested buffers to have some modeline
+;; identification, so we'll make a "minor mode".  We don't use
+;; `add-minor-mode', as we don't want it to be togglable.
+(defvar gnuserv-minor-mode nil)
+(make-variable-buffer-local 'gnuserv-mode)
+(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist :test 'equal)
 (defvar gnuserv-special-frame nil
 "Frame created specially for Server.")
-;; We want the client-infested buffers to have some modeline
-;; identification, so we'll make a "minor mode".
-(defvar gnuserv-minor-mode nil)
-(make-variable-buffer-local 'gnuserv-mode)
-(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist
-	  :test 'equal)
-;; Sample gnuserv-frame functions
+;; Creating gnuserv frame.
-(defun gnuserv-main-frame-function (type)
+(defun gnuserv-frame-default-function (arg device)
-"Returns a sensible value for the main Emacs frame."
+"Default function to create Gnuserv frames.
-(if (eq type 'x)
+See the documentation of `gnuserv-frame' for instructions how to
-(car (frame-list))
+customize it."
-nil))
+;; If we are on TTY, act as if `new' was given.
+(if (not (device-on-window-system-p))
-(defun gnuserv-visible-frame-function (type)
+(gnuserv-frame-default-function 'new device)
-"Returns a frame if there is a frame that is truly visible, nil otherwise.
+(cond
-This is meant in the X sense, so it will not return frames that are on another
+((or (eq arg 'new)
-visual screen.  Totally visible frames are preferred.  If none found, return nil."
+	   ;; nil for back-compat
-(if (eq type 'x)
+	   (eq arg nil))
-(cond ((car (filtered-frame-list 'frame-totally-visible-p
+(make-frame gnuserv-frame-properties device))
-				       (selected-device))))
+((or (eq arg 'current)
-	    ((car (filtered-frame-list (lambda (frame)
+	   ;; t for back-compat
-					 ;; eq t as in not 'hidden
+	   (eq arg t))
-					 (eq t (frame-visible-p frame)))
+(selected-frame))
-				       (selected-device)))))
+((eq arg 'main)
-nil))
+(car (frame-list)))
+((eq arg 'visible)
-(defun gnuserv-special-frame-function (type)
+(cond ((car (filtered-frame-list 'frame-totally-visible-p device)))
-"Creates a special frame for Gnuserv and returns it on later invocations."
+	     ((car (filtered-frame-list (lambda (frame)
-(unless (frame-live-p gnuserv-special-frame)
+					  ;; eq t as in not 'hidden
-(setq gnuserv-special-frame (make-frame)))
+					  (eq (frame-visible-p frame) t))
-gnuserv-special-frame)
+					device)))
+	     (t (make-frame gnuserv-frame-properties device))))
+((eq arg 'special)
+(unless (frame-live-p gnuserv-special-frame)
+	 (setq gnuserv-special-frame
+	       (make-frame gnuserv-frame-properties device))))
+((frame-live-p arg)
+arg)
+(t
+(error "Invalid argument %s" arg)))))
 ;;; Communication functions
 ;; We used to restart the server here, but it's too risky -- if
 	      (quick (setq quick t))
 	      (view  (setq view t))
 	      (t     (error "Invalid flag %s" flag))))
 	  flags)
 (let* ((old-device-num (length (device-list)))
-	   (new-frame nil)
+	   (old-frame-num  (length (frame-list)))
-	   (dest-frame (if (functionp gnuserv-frame)
+	   (device (case (car type)
-			   (funcall gnuserv-frame (car type))
-			 gnuserv-frame))
-	   ;; The gnuserv-frame dependencies are ugly.
-	   (device (cond ((frame-live-p dest-frame)
-			  (frame-device dest-frame))
-			 ((null dest-frame)
-			  (case (car type)
 			    (tty (apply 'make-tty-device (cdr type)))
 			    (x   (make-x-device (cadr type)))
 			    (t   (error "Invalid device type"))))
-			 (t
+	   (frame (funcall gnuserv-frame-function gnuserv-frame device))
-			  (selected-device))))
-	   (frame (cond ((frame-live-p dest-frame)
-			 dest-frame)
-			((null dest-frame)
-			 (setq new-frame (make-frame nil device))
-			 new-frame)
-			(t (selected-frame))))
 	   (client (make-gnuclient :id gnuserv-current-client
 				   :device device
-				   :frame new-frame)))
+				   :frame (if (= (length (frame-list))
+						 old-frame-num)
+					      nil frame))))
 (setq gnuserv-current-client nil)
 ;; If the device was created by this client, push it to the list.
 (and (/= old-device-num (length (device-list)))
 	   (push device gnuserv-devices))
 (and (frame-iconified-p frame)
 	   (deiconify-frame frame))
 ;; Visit all the listed files.
 (while list
 	(let ((line (caar list)) (path (cdar list)))
 	  (select-frame frame)
+	  (raise-frame frame)
 	  ;; Visit the file.
 	  (funcall (if view
 		       gnuserv-view-file-function
 		     gnuserv-find-file-function)
 		   path)
 	  ;; Don't memorize the quick and view buffers.
 	  (unless (or quick view)
 	    (pushnew (current-buffer) (gnuclient-buffers client))
 	    (setq gnuserv-minor-mode t)
 	    ;; Add the "Done" button to the menubar, only in this buffer.
-	    (if (boundp 'current-menubar)
+	    (when (boundp 'current-menubar)
-	      (progn (set-buffer-menubar current-menubar)
+	      (set-buffer-menubar current-menubar)
-	      (add-menu-button nil ["Done" gnuserv-edit t]))
+	      (add-menu-button nil ["Done" gnuserv-edit t])))
-	      ))
 	  (run-hooks 'gnuserv-visit-hook)
 	  (pop list)))
 (cond
 ((and (or quick view)
 	     (device-on-window-system-p device))
 	;; should be unique.
 	(gnuserv-write-to-client (gnuclient-id client) nil))
 (t
 	;; Else, the client gets a vote.
 	(push client gnuserv-clients)
-	;; Explain buffer exit options.  If dest-frame is nil, the
+	;; Explain buffer exit options.  If client-frame is non-nil,
-	;; user can exit via `delete-frame'.  OTOH, if FLAGS are nil
+	;; the user can exit via `delete-frame'.  OTOH, if FLAGS are
-	;; and there are some buffers, the user can exit via
+	;; nil and there are some buffers, the user can exit via
 	;; `gnuserv-edit'.
 	(if (and (not (or quick view))
 		 (gnuclient-buffers client))
 	    (message "%s"
 		     (substitute-command-keys
 		      "Type `\\[gnuserv-edit]' to finish editing"))
-	  (or dest-frame
+	  (and (gnuclient-frame client)
-	      (message "%s"
+	       (message "%s"
-		       (substitute-command-keys
+			(substitute-command-keys
-			"Type `\\[delete-frame]' to finish editing")))))))))
+			 "Type `\\[delete-frame]' to finish editing")))))))))
 ;;; Functions that hook into Emacs in various way to enable operation
 ;; Defined later.
 ;; possible, because it is slow, and conses a list.  Use
 ;; `gnuserv-buffer-p' when appropriate, for instance.
 (defun gnuserv-buffer-clients (buffer)
 "Returns a list of clients to which BUFFER belongs."
 (let (res)
-(dolist (client gnuserv-clients)
+(dolist (client gnuserv-clients res)
 (when (memq buffer (gnuclient-buffers client))
-	(push client res)))
+	(push client res)))))
-res))
 ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't
 ;; collect a list.
 (defun gnuserv-buffer-p (buffer)
 (member* buffer gnuserv-clients
 	;; error when `delete-device' tries to do the job later.
 	(gnuserv-kill-client client t))))
 (callf2 delq device gnuserv-devices))
 (add-hook 'delete-device-hook 'gnuserv-check-device)
-(defun gnuserv-temp-file-p (buffer)
-"Return non-nil if BUFFER contains a file considered temporary.
-These are files whose names suggest they are repeatedly
-reused to pass information to another program.
-The variable `gnuserv-temp-file-regexp' controls which filenames
-are considered temporary."
-(and (buffer-file-name buffer)
-(string-match gnuserv-temp-file-regexp (buffer-file-name buffer))))
 (defun gnuserv-kill-client (client &optional leave-frame)
 "Kill the gnuclient CLIENT.
 This will do away with all the associated buffers.  If LEAVE-FRAME,
 the function will not remove the frames associated with the client."
 (run-hooks 'gnuserv-done-hook)
 (setq gnuserv-minor-mode nil)
 ;; Delete the menu button.
 (if (boundp 'current-menubar)
 (delete-menu-item '("Done")))
-(funcall (if (gnuserv-temp-file-p buffer)
+(funcall gnuserv-done-function buffer)))
-		 gnuserv-done-temp-file-function
-	       gnuserv-done-function)
-	     buffer)))
 ;;; Higher-level functions
 ;; Choose a `next' server buffer, according to several criteria, and
 Does the save/backup queries first, and calls `gnuserv-done-function'."
 ;; Check whether this is the real thing.
 (unless (gnuserv-buffer-p buffer)
 (error "%s does not belong to a gnuserv client" buffer))
 ;; Backup/ask query.
-(if (gnuserv-temp-file-p buffer)
+(if (and (buffer-modified-p)
-;; For a temp file, save, and do NOT make a non-numeric backup
+	   (y-or-n-p (concat "Save file " buffer-file-name "? ")))
-;; Why does server.el explicitly back up temporary files?
+(save-buffer buffer))
-(let ((version-control nil)
-	    (buffer-backed-up (not gnuserv-make-temp-file-backup)))
-	(save-buffer))
-(if (and (buffer-modified-p)
-	     (y-or-n-p (concat "Save file " buffer-file-name "? ")))
-	(save-buffer buffer)))
 (gnuserv-buffer-done-1 buffer))
 ;; Called by `gnuserv-start-1' to clean everything.  Hooked into
 ;; `kill-emacs-hook', too.
 (defun gnuserv-kill-all-clients ()
 (not (not gnuserv-process)))
 ;;;###autoload
 (defun gnuserv-start (&optional leave-dead)
 "Allow this Emacs process to be a server for client processes.
 This starts a gnuserv communications subprocess through which
 client \"editors\" (gnuclient and gnudoit) can send editing commands to
 this Emacs job.  See the gnuserv(1) manual page for more details.
 Prefix arg means just kill any existing server communications subprocess."
 (interactive "P")
 (and gnuserv-process
 (not leave-dead)
 (message "Restarting gnuserv"))
 (gnuserv-start-1 leave-dead))
 (defun gnuserv-edit (&optional count)
-"Mark the current gnuserv editing buffer as \"done\", and switch to next one.
+"Mark the current gnuserv buffer as \"done\", and switch to next one.
 Run with a numeric prefix argument, repeat the operation that number
 of times.  If given a universal prefix argument, close all the buffers
 of this buffer's clients.
+The `gnuserv-done-function' (`kill-buffer' by default) is called to
-The `gnuserv-done-function' (bound to `kill-buffer' by default) is
+dispose of the buffer after marking it as done.
-called to dispose of the buffer after marking it as done.
+When all of a client's buffers are marked as \"done\", the client is
+notified."
-Files that match `gnuserv-temp-file-regexp' are considered temporary and
-are saved unconditionally and backed up if `gnuserv-make-temp-file-backup'
-is non-nil.  They are disposed of using `gnuserv-done-temp-file-function'
-(also bound to `kill-buffer' by default).
-When all of a client's buffers are marked as \"done\", the client is notified."
 (interactive "P")
 (when (null count)
 (setq count 1))
 (cond ((numberp count)
 	 (let (next)

Mercurial > hg > xemacs-beta

comparison lisp/packages/gnuserv.el @ 193:f53b5ca2e663 r20-3b23