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