Mercurial > hg > xemacs-beta
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 ;;;