1;; gnuserv-compat.el - Help GNU XEmacs gnuserv.el work under GNU Emacs.
2;; Copyright (C) 1998, 1999, 2000 Martin Schwenke
3;;
4;; Author: Martin Schwenke <martin@meltin.net>
5;; Maintainer: Martin Schwenke <martin@meltin.net>
6;; Created: 20 November 1998
7;; $Id$
8;; Keywords: gnuserv
9
10;; This program is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14;;
15;; This program is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19;;
20;; If you have not received a copy of the GNU General Public License
21;; along with this software, it can be obtained from the GNU Project's
22;; World Wide Web server (http://www.gnu.org/copyleft/gpl.html), from
23;; its FTP server (ftp://ftp.gnu.org/pub/gnu/GPL), by sending an electronic
24;; mail to this program's maintainer or by writing to the Free Software
25;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28;;
29;; Under non-XEmacs (tested 19.34 <= ... <= 20.7)
30;;
31;;   (autoload 'gnuserv-start "gnuserv-compat"
32;;             "Allow this Emacs process to be a server for client processes."
33;;             t)
34;;
35;; Note that this file does a (require 'gnuserv) near the end.
36;;
37;; This code does a few things including:
38;;
39;; * A poor emulation of XEmacs' device handling, mapping devices to
40;;   frames.  See the (tiny bit of) code for details.  Note that this
41;;   emulation might only work for the version of gnuserv that it
42;;   comes with.  Other stuff that uses XEmacs devices might behave
43;;   badly when used with this emulation.
44
45
46;;; Code:
47
48;; Miscellaneous functions that are in XEmacs but not GNU Emacs up to
49;; 20.3.  Also, XEmacs preloads the common lisp stuff, and we might as
50;; well use it here.
51
52(require 'cl)
53
54(unless (fboundp 'define-obsolete-variable-alias)
55  (defalias 'define-obsolete-variable-alias 'make-obsolete-variable))
56
57(unless (fboundp 'functionp)
58  (defun functionp (object)
59    "Non-nil if OBJECT is a type of object that can be called as a function."
60    (or (subrp object) (byte-code-function-p object)
61	(eq (car-safe object) 'lambda)
62	(and (symbolp object) (fboundp object)))))
63
64;;; temporary-file-directory not available in 19.34
65(unless (boundp 'temporary-file-directory)
66  (defvar temporary-file-directory
67    (cond
68     ((getenv "TMPDIR"))
69     (t "/tmp"))))
70
71(unless (fboundp 'temp-directory)
72  (defun temp-directory ()
73    "Return the pathname to the directory to use for temporary files.
74On NT/MSDOS, this is obtained from the TEMP or TMP environment variables,
75defaulting to the value of `temporary-file-directory' if they are both
76undefined.  On Unix it is obtained from TMPDIR, with the value of
77`temporary-file-directory' as the default."
78
79    (if	(eq system-type 'windows-nt)
80	(cond
81	 ((getenv "TEMP"))
82	 ((getenv "TMP"))
83	 (t (directory-file-name temporary-file-directory)))
84      (cond
85	  ((getenv "TMPDIR"))
86	  (t (directory-file-name temporary-file-directory))))))
87
88
89;; If we're not running XEmacs then advise `make-frame',
90;; `delete-frame' and `filtered-frame-list' to handle some device
91;; stuff.
92
93(if (string-match "XEmacs" (emacs-version))
94    nil
95
96  ;; XEmacs `make-frame' takes an optional device to create the frame
97  ;; on.  Since `make-device' just calls 'make-frame', we don't want
98  ;; to make a new frame on both occasions.  Therefore, if the device
99  ;; already represents a live frame, we modify the frame parameters
100  ;; as desired and then return the existing frame.  Modifying the
101  ;; frame parameters can cause an annoying flicker, but that's all we
102  ;; can do!  If the device doesn't represent a live frame, we create
103  ;; the frame as requested.
104
105  (defadvice make-frame (around
106			 gnuserv-compat-make-frame
107			 first
108			 (&optional parameters device)
109			 activate)
110    (if (and device
111	     (frame-live-p device))
112	(progn
113	  (if parameters
114	      (modify-frame-parameters device parameters))
115	  (setq ad-return-value device))
116      ad-do-it))
117
118  ;; Advise `delete-frame' to run `delete-device-hook'.  This might be a
119  ;; little too hacky, but it seems to work!  If someone actually tries
120  ;; to do something device specific then it will probably blow up!
121  (defadvice delete-frame (before
122			   gnuserv-compat-delete-frame
123			   first
124			   nil
125			   activate)
126    (run-hook-with-args 'delete-device-hook frame))
127
128  ;; Advise `filtered-frame-list' to ignore the optional device
129  ;; argument.  Here we don't follow the mapping of devices to frames.
130  ;; We just assume that any frame satisfying the predicate will do.
131  (defadvice filtered-frame-list (around
132				  gnuserv-compat-filtered-frame-list
133				  first
134				  (predicate &optional device)
135				  activate)
136    ad-do-it))
137
138
139;; Emulate XEmacs devices.  A device is just a frame. For the most
140;; part we use devices.el from the Emacs-W3 distribution.  In some
141;; places the implementation seems wrong, so we "fix" it!
142
143(if (string-match "XEmacs" (emacs-version))
144    nil
145
146  (require 'devices)
147  (defalias 'device-list 'frame-list)
148  (defalias 'selected-device 'selected-frame)
149  (defun device-frame-list (&optional device)
150    (list
151     (if device
152	device
153       (selected-frame)))))
154
155
156
157;; Check iconification and perform deiconification the GNU Emacs way.
158;; There might be some XEmacs subtlty that I'm missing, but it seems
159;; to do the job.
160(unless (fboundp 'frame-iconified-p)
161  (defun frame-iconified-p (frame)
162    (equal (frame-visible-p frame) 'icon)))
163
164(unless (fboundp 'deiconify-frame)
165  (defalias 'deiconify-frame 'make-frame-visible))
166
167;; GNU Emacs doesn't have a way of checking if a frame is totally
168;; visible, so we just do something sensible.
169(unless (fboundp 'frame-totally-visible-p)
170  (defun frame-totally-visible-p (frame)
171    (eq t (frame-visible-p frame))))
172
173;; Make custom stuff work even without customize
174;;   Courtesy of Hrvoje Niksic <hniksic@srce.hr>
175;;   via Ronan Waide <waider@scope.ie>.
176(eval-and-compile
177  (condition-case ()
178      (require 'custom)
179    (error nil))
180  (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
181      nil ;; We've got what we needed
182    ;; We have the old custom-library, hack around it!
183    (defmacro defgroup (&rest args)
184      nil)
185    (defmacro defcustom (var value doc &rest args)
186      (` (defvar (, var) (, value) (, doc))))
187    (defmacro defface (var value doc &rest args)
188      (` (make-face (, var))))
189    (defmacro define-widget (&rest args)
190      nil)))
191
192;; Now for gnuserv...
193(require 'gnuserv)
194
195(provide 'gnuserv-compat)
196
197;;; gnuserv-compat.el ends here
198