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