diff lisp/tl/emu-xemacs.el @ 8:4b173ad71786 r19-15b5

Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents b82b59fe008d
children ec9a17fef872
line wrap: on
line diff
--- a/lisp/tl/emu-xemacs.el	Mon Aug 13 08:47:16 2007 +0200
+++ b/lisp/tl/emu-xemacs.el	Mon Aug 13 08:47:35 2007 +0200
@@ -1,14 +1,14 @@
-;;; emu-xemacs.el --- Emacs 19 emulation module for XEmacs
+;;; emu-xemacs.el --- emu API implementation for XEmacs
 
 ;; Copyright (C) 1995 Free Software Foundation, Inc.
 ;; Copyright (C) 1995,1996 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Version:
-;;	$Id: emu-xemacs.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $
+;;	$Id: emu-xemacs.el,v 1.2 1996/12/22 00:29:30 steve Exp $
 ;; Keywords: emulation, compatibility, XEmacs
 
-;; This file is part of tl (Tiny Library).
+;; This file is part of emu.
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -21,9 +21,9 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
 
 ;;; Code:
 
@@ -141,6 +141,29 @@
   `(mapconcat #'char-to-string ,char-list ""))
 
 
+;;; @@ to avoid bug of XEmacs 19.14
+;;;
+
+(or (string-match "^../"
+		  (file-relative-name "/usr/local/share" "/usr/local/lib"))
+    ;; This function was imported from Emacs 19.33.
+    (defun file-relative-name (filename &optional directory)
+      "Convert FILENAME to be relative to DIRECTORY
+(default: default-directory). [emu-xemacs.el]"
+      (setq filename (expand-file-name filename)
+	    directory (file-name-as-directory
+		       (expand-file-name
+			(or directory default-directory))))
+      (let ((ancestor ""))
+	(while (not (string-match (concat "^" (regexp-quote directory))
+				  filename))
+	  (setq directory (file-name-directory (substring directory 0 -1))
+		ancestor (concat "../" ancestor)))
+	(concat ancestor (substring filename (match-end 0)))
+	))
+    )
+
+    
 ;;; @ end
 ;;;