;; gnuserv-compat.el - Help GNU XEmacs gnuserv.el work under GNU Emacs. ;; Copyright (C) 1998, 1999, 2000 Martin Schwenke ;; ;; Author: Martin Schwenke <martin@meltin.net> ;; Maintainer: Martin Schwenke <martin@meltin.net> ;; Created: 20 November 1998 ;; $Id$ ;; 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 19.34 <= ... <= 20.7) ;; ;; (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) (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))))) ;;; 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)))))) ;; 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