;;; Code:
(setq emu-modules
- (cons
- 'emu
- (if (or running-emacs-19_29-or-later
- running-xemacs-19_14-or-later)
- '(richtext)
- '(tinyrich)
- )))
+ (append '(poe emu)
+ (if (or running-emacs-19_29-or-later
+ running-xemacs-19_14-or-later)
+ '(richtext)
+ '(tinyrich)
+ )))
(setq emu-modules
(nconc
(cond (running-xemacs
;; for XEmacs
- (cons 'emu-xemacs
+ (cons 'poe-xemacs
(if (featurep 'mule)
'(emu-20 emu-x20) ; for XEmacs with MULE
'(emu-latin1) ; for XEmacs without MULE
'emu-e20_3 ; for Emacs 20.3
'emu-e20_2 ; for Emacs 20.1 and 20.2
)
- '(emu-20 emu-e19 emu-e20))
+ '(emu-20 poe-19 emu-e20))
)
((boundp 'MULE)
;; for MULE 1.* and MULE 2.*
(cons 'emu-mule
(if running-emacs-18
- '(emu-18 env)
- '(emu-e19)))
+ '(poe-18 env)
+ '(poe-19)))
)
((boundp 'NEMACS)
;; for NEmacs
- '(emu-18 emu-nemacs)
+ '(poe-18 emu-nemacs)
)
(t
;; for Emacs 19.34
- '(emu-e19 emu-latin1)
+ '(poe-19 emu-latin1)
))
emu-modules))
+++ /dev/null
-;;; emu-18.el --- emu API implementation for Emacs 18.*
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Id: emu-18.el,v 7.33 1997/04/05 06:44:01 morioka Exp $
-;; Keywords: emulation, compatibility
-
-;; 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
-;; 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.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(autoload 'setenv "env"
- "Set the value of the environment variable named VARIABLE to VALUE.
-VARIABLE should be a string. VALUE is optional; if not provided or is
-`nil', the environment variable VARIABLE will be removed.
-This function works by modifying `process-environment'."
- t)
-
-(defvar data-directory exec-directory)
-
-
-;;; @ for EMACS 18.55
-;;;
-
-(defvar buffer-undo-list nil)
-
-
-;;; @ hook
-;;;
-
-;; These function are imported from EMACS 19.28.
-(defun add-hook (hook function &optional append)
- "Add to the value of HOOK the function FUNCTION.
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-HOOK should be a symbol, and FUNCTION may be any valid function. If
-HOOK is void, it is first set to nil. If HOOK's value is a single
-function, it is changed to a list of functions.
-\[emu-18.el; EMACS 19 emulating function]"
- (or (boundp hook)
- (set hook nil)
- )
- ;; If the hook value is a single function, turn it into a list.
- (let ((old (symbol-value hook)))
- (if (or (not (listp old))
- (eq (car old) 'lambda))
- (set hook (list old))
- ))
- (or (if (consp function)
- ;; Clever way to tell whether a given lambda-expression
- ;; is equal to anything in the hook.
- (let ((tail (assoc (cdr function) (symbol-value hook))))
- (equal function tail)
- )
- (memq function (symbol-value hook))
- )
- (set hook
- (if append
- (nconc (symbol-value hook) (list function))
- (cons function (symbol-value hook))
- ))
- ))
-
-(defun remove-hook (hook function)
- "Remove from the value of HOOK the function FUNCTION.
-HOOK should be a symbol, and FUNCTION may be any valid function. If
-FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
-list of hooks to run in HOOK, then nothing is done. See `add-hook'.
-\[emu-18.el; EMACS 19 emulating function]"
- (if (or (not (boundp hook)) ;unbound symbol, or
- (null (symbol-value hook)) ;value is nil, or
- (null function)) ;function is nil, then
- nil ;Do nothing.
- (let ((hook-value (symbol-value hook)))
- (if (consp hook-value)
- (setq hook-value (delete function hook-value))
- (if (equal hook-value function)
- (setq hook-value nil)
- ))
- (set hook hook-value)
- )))
-
-
-;;; @ list
-;;;
-
-(defun member (elt list)
- "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL.
-The value is actually the tail of LIST whose car is ELT.
-\[emu-18.el; EMACS 19 emulating function]"
- (while (and list (not (equal elt (car list))))
- (setq list (cdr list)))
- list)
-
-(defun delete (elt list)
- "Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `equal'.
-If the first member of LIST is ELT, deleting it is not a side effect;
-it is simply using a different list.
-Therefore, write `(setq foo (delete element foo))'
-to be sure of changing the value of `foo'.
-\[emu-18.el; EMACS 19 emulating function]"
- (if (equal elt (car list))
- (cdr list)
- (let ((rest list)
- (rrest (cdr list))
- )
- (while (and rrest (not (equal elt (car rrest))))
- (setq rest rrest
- rrest (cdr rrest))
- )
- (rplacd rest (cdr rrest))
- list)))
-
-
-;;; @ function
-;;;
-
-(defun defalias (sym newdef)
- "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
-Associates the function with the current load file, if any.
-\[emu-18.el; EMACS 19 emulating function]"
- (fset sym newdef)
- )
-
-(defun byte-code-function-p (exp)
- "T if OBJECT is a byte-compiled function object.
-\[emu-18.el; EMACS 19 emulating function]"
- (and (consp exp)
- (let* ((rest (cdr (cdr exp))) elt)
- (if (stringp (car rest))
- (setq rest (cdr rest))
- )
- (catch 'tag
- (while rest
- (setq elt (car rest))
- (if (and (consp elt)(eq (car elt) 'byte-code))
- (throw 'tag t)
- )
- (setq rest (cdr rest))
- ))
- )))
-
-(defmacro-maybe defsubst (name arglist &rest body)
- "Define an inline function. The syntax is just like that of `defun'."
- (cons 'defun (cons name (cons arglist body)))
- )
-
-
-;;; @ file
-;;;
-
-(defun make-directory-internal (dirname)
- "Create a directory. One argument, a file name string.
-\[emu-18.el; EMACS 19 emulating function]"
- (if (file-exists-p dirname)
- (error "Creating directory: %s is already exist" dirname)
- (if (not (= (call-process "mkdir" nil nil nil dirname) 0))
- (error "Creating directory: no such file or directory, %s" dirname)
- )))
-
-(defun make-directory (dir &optional parents)
- "Create the directory DIR and any nonexistent parent dirs.
-The second (optional) argument PARENTS says whether
-to create parent directories if they don't exist.
-\[emu-18.el; EMACS 19 emulating function]"
- (let ((len (length dir))
- (p 0) p1 path)
- (catch 'tag
- (while (and (< p len) (string-match "[^/]*/?" dir p))
- (setq p1 (match-end 0))
- (if (= p1 len)
- (throw 'tag nil)
- )
- (setq path (substring dir 0 p1))
- (if (not (file-directory-p path))
- (cond ((file-exists-p path)
- (error "Creating directory: %s is not directory" path)
- )
- ((null parents)
- (error "Creating directory: %s is not exist" path)
- )
- (t
- (make-directory-internal path)
- ))
- )
- (setq p p1)
- ))
- (make-directory-internal dir)
- ))
-
-;; Imported from files.el of EMACS 19.33.
-(defun parse-colon-path (cd-path)
- "Explode a colon-separated list of paths into a string list."
- (and cd-path
- (let (cd-prefix cd-list (cd-start 0) cd-colon)
- (setq cd-path (concat cd-path path-separator))
- (while (setq cd-colon (string-match path-separator cd-path cd-start))
- (setq cd-list
- (nconc cd-list
- (list (if (= cd-start cd-colon)
- nil
- (substitute-in-file-name
- (file-name-as-directory
- (substring cd-path cd-start cd-colon)))))))
- (setq cd-start (+ cd-colon 1)))
- cd-list)))
-
-;; Imported from files.el of EMACS 19.33.
-(defun file-relative-name (filename &optional directory)
- "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
- (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)))))
-
-(or (fboundp 'si:directory-files)
- (fset 'si:directory-files (symbol-function 'directory-files)))
-(defun directory-files (directory &optional full match nosort)
- "Return a list of names of files in DIRECTORY.
-There are three optional arguments:
-If FULL is non-nil, return absolute file names. Otherwise return names
- that are relative to the specified directory.
-If MATCH is non-nil, mention only file names that match the regexp MATCH.
-If NOSORT is dummy for compatibility.
-\[emu-18.el; EMACS 19 emulating function]"
- (si:directory-files directory full match)
- )
-
-
-;;; @ mark
-;;;
-
-(or (fboundp 'si:mark)
- (fset 'si:mark (symbol-function 'mark)))
-(defun mark (&optional force)
- (si:mark)
- )
-
-
-;;; @ mode-line
-;;;
-
-;;; Imported from Emacs 19.30.
-(defun force-mode-line-update (&optional all)
- "Force the mode-line of the current buffer to be redisplayed.
-With optional non-nil ALL, force redisplay of all mode-lines.
-\[emu-18.el; Emacs 19 emulating function]"
- (if all (save-excursion (set-buffer (other-buffer))))
- (set-buffer-modified-p (buffer-modified-p)))
-
-
-;;; @ overlay
-;;;
-
-(defun overlay-buffer (overlay))
-
-
-;;; @ text property
-;;;
-
-(defun remove-text-properties (start end properties &optional object))
-
-
-;;; @@ visible/invisible
-;;;
-
-(defmacro enable-invisible ()
- (`
- (progn
- (make-local-variable 'original-selective-display)
- (setq original-selective-display selective-display)
- (setq selective-display t)
- )))
-
-(defmacro end-of-invisible ()
- (` (setq selective-display
- (if (boundp 'original-selective-display)
- original-selective-display))
- ))
-
-(defun invisible-region (start end)
- (let ((buffer-read-only nil) ;Okay even if write protected.
- (modp (buffer-modified-p)))
- (if (save-excursion
- (goto-char (1- end))
- (eq (following-char) ?\n)
- )
- (setq end (1- end))
- )
- (unwind-protect
- (subst-char-in-region start end ?\n ?\^M t)
- (set-buffer-modified-p modp)
- )))
-
-(defun visible-region (start end)
- (let ((buffer-read-only nil) ;Okay even if write protected.
- (modp (buffer-modified-p)))
- (unwind-protect
- (subst-char-in-region start end ?\^M ?\n t)
- (set-buffer-modified-p modp)
- )))
-
-(defun invisible-p (pos)
- (save-excursion
- (goto-char pos)
- (eq (following-char) ?\^M)
- ))
-
-(defun next-visible-point (pos)
- (save-excursion
- (goto-char pos)
- (end-of-line)
- (if (eq (following-char) ?\n)
- (forward-char)
- )
- (point)
- ))
-
-
-;;; @ mouse
-;;;
-
-(defvar mouse-button-1 nil)
-(defvar mouse-button-2 nil)
-(defvar mouse-button-3 nil)
-
-
-;;; @ string
-;;;
-
-(defun char-list-to-string (char-list)
- "Convert list of character CHAR-LIST to string. [emu-18.el]"
- (mapconcat (function char-to-string) char-list "")
- )
-
-
-;;; @ buffer
-;;;
-
-(defun-maybe generate-new-buffer-name (name &optional ignore)
- "Return a string that is the name of no existing buffer based on NAME.
-If there is no live buffer named NAME, then return NAME.
-Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
-until an unused name is found, and then return that name.
-Optional second argument IGNORE specifies a name that is okay to use
-\(if it is in the sequence to be tried)
-even if a buffer with that name exists."
- (if (get-buffer name)
- (let ((n 2) new)
- (while (get-buffer (setq new (format "%s<%d>" name n)))
- (setq n (1+ n)))
- new)
- name))
-
-
-;;; @ end
-;;;
-
-(provide 'emu-18)
-
-;;; emu-18.el ends here
+++ /dev/null
-;;; emu-e19.el --- emu API implementation for Emacs 19.*
-
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Keywords: emulation, compatibility
-
-;; 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
-;; 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.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-;;; @ face
-;;;
-
-(defun-maybe find-face (face)
- (car (memq face (face-list)))
- )
-
-
-;;; @ for tm-7.106
-;;;
-
-(defalias 'tl:make-overlay 'make-overlay)
-(defalias 'tl:overlay-put 'overlay-put)
-(defalias 'tl:overlay-buffer 'overlay-buffer)
-
-(make-obsolete 'tl:make-overlay 'make-overlay)
-(make-obsolete 'tl:overlay-put 'overlay-put)
-(make-obsolete 'tl:overlay-buffer 'overlay-buffer)
-
-
-;;; @ visible/invisible
-;;;
-
-(defmacro enable-invisible ())
-
-(defmacro end-of-invisible ())
-
-(defun invisible-region (start end)
- (if (save-excursion
- (goto-char (1- end))
- (eq (following-char) ?\n)
- )
- (setq end (1- end))
- )
- (put-text-property start end 'invisible t)
- )
-
-(defun visible-region (start end)
- (put-text-property start end 'invisible nil)
- )
-
-(defun invisible-p (pos)
- (get-text-property pos 'invisible)
- )
-
-(defun next-visible-point (pos)
- (save-excursion
- (goto-char (next-single-property-change pos 'invisible))
- (if (eq (following-char) ?\n)
- (forward-char)
- )
- (point)))
-
-
-;;; @ mouse
-;;;
-
-(defvar mouse-button-1 [mouse-1])
-(defvar mouse-button-2 [mouse-2])
-(defvar mouse-button-3 [down-mouse-3])
-
-
-;;; @ string
-;;;
-
-(defmacro char-list-to-string (char-list)
- "Convert list of character CHAR-LIST to string."
- (` (mapconcat (function char-to-string)
- (, char-list)
- "")))
-
-
-;;; @ end
-;;;
-
-(provide 'emu-e19)
-
-;;; emu-e19.el ends here
;;; Code:
-(require 'emu-e19)
+(require 'poe)
(defun fontset-pixel-size (fontset)
(let* ((info (fontset-info fontset))
;;; @ version specific features
;;;
+(require 'poe)
+
(cond (running-emacs-19
- (require 'emu-e19)
-
;; Suggested by SASAKI Osamu <osamu@shuugr.bekkoame.or.jp>
;; (cf. [os2-emacs-ja:78])
(defun fontset-pixel-size (fontset)
))))
)
(running-emacs-18
- (require 'emu-18)
(defun make-overlay (beg end &optional buffer type))
(defun overlay-put (overlay prop value))
))
;;; Code:
-(require 'emu-18)
+(require 'poe)
;;; @ character set
+++ /dev/null
-;;; emu-xemacs.el --- emu API implementation for XEmacs
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version:
-;; $Id: emu-xemacs.el,v 7.19 1997/04/05 06:50:48 morioka Exp $
-;; Keywords: emulation, compatibility, XEmacs
-
-;; This file is part of XEmacs.
-
-;; 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.
-
-;; You should have received a copy of the GNU General Public License
-;; 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:
-
-;;; @ face
-;;;
-
-(or (fboundp 'face-list)
- (defalias 'face-list 'list-faces)
- )
-
-(or (memq 'underline (face-list))
- (and (fboundp 'make-face)
- (make-face 'underline)
- ))
-
-(or (face-differs-from-default-p 'underline)
- (set-face-underline-p 'underline t))
-
-
-;;; @ overlay
-;;;
-
-(condition-case nil
- (require 'overlay)
- (error (defalias 'make-overlay 'make-extent)
- (defalias 'overlay-put 'set-extent-property)
- (defalias 'overlay-buffer 'extent-buffer)
- (defun move-overlay (extent start end &optional buffer)
- (set-extent-endpoints extent start end)
- )
- ))
-
-
-;;; @ visible/invisible
-;;;
-
-(defmacro enable-invisible ())
-
-(defmacro end-of-invisible ())
-
-(defun invisible-region (start end)
- (if (save-excursion
- (goto-char start)
- (eq (following-char) ?\n))
- (setq start (1+ start))
- )
- (put-text-property start end 'invisible t)
- )
-
-(defun visible-region (start end)
- (put-text-property start end 'invisible nil)
- )
-
-(defun invisible-p (pos)
- (if (save-excursion
- (goto-char pos)
- (eq (following-char) ?\n))
- (setq pos (1+ pos))
- )
- (get-text-property pos 'invisible)
- )
-
-(defun next-visible-point (pos)
- (save-excursion
- (if (save-excursion
- (goto-char pos)
- (eq (following-char) ?\n))
- (setq pos (1+ pos))
- )
- (or (next-single-property-change pos 'invisible)
- (point-max))))
-
-
-;;; @ mouse
-;;;
-
-(defvar mouse-button-1 'button1)
-(defvar mouse-button-2 'button2)
-(defvar mouse-button-3 'button3)
-
-
-;;; @ dired
-;;;
-
-(or (fboundp 'dired-other-frame)
- (defun dired-other-frame (dirname &optional switches)
- "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
- (interactive (dired-read-dir-and-switches "in other frame "))
- (switch-to-buffer-other-frame (dired-noselect dirname switches)))
- )
-
-
-;;; @ string
-;;;
-
-(defmacro char-list-to-string (char-list)
- "Convert list of character CHAR-LIST to string. [emu-xemacs.el]"
- `(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
-;;;
-
-(provide 'emu-xemacs)
-
-;;; emu-xemacs.el ends here
;;; Code:
-(defmacro defun-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defun-maybe))
- )
- (` (or (fboundp (quote (, name)))
- (progn
- (defun (, name) (,@ everything-else))
- (put (quote (, name)) 'defun-maybe t)
- ))
- )))
-
-(defmacro defsubst-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defsubst-maybe))
- )
- (` (or (fboundp (quote (, name)))
- (progn
- (defsubst (, name) (,@ everything-else))
- (put (quote (, name)) 'defsubst-maybe t)
- ))
- )))
-
-(defmacro defmacro-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defmacro-maybe))
- )
- (` (or (fboundp (quote (, name)))
- (progn
- (defmacro (, name) (,@ everything-else))
- (put (quote (, name)) 'defmacro-maybe t)
- ))
- )))
-
-(put 'defun-maybe 'lisp-indent-function 'defun)
-(put 'defsubst-maybe 'lisp-indent-function 'defun)
-(put 'defmacro-maybe 'lisp-indent-function 'defun)
-
-(defmacro defconst-maybe (name &rest everything-else)
- (or (and (boundp name)
- (not (get name 'defconst-maybe))
- )
- (` (or (boundp (quote (, name)))
- (progn
- (defconst (, name) (,@ everything-else))
- (put (quote (, name)) 'defconst-maybe t)
- ))
- )))
-
-
-(defconst-maybe emacs-major-version (string-to-int emacs-version))
+(require 'poe)
+
(defconst-maybe emacs-minor-version
(string-to-int
(substring emacs-version
(cond (running-xemacs
;; for XEmacs
- (require 'emu-xemacs)
+ (defvar mouse-button-1 'button1)
+ (defvar mouse-button-2 'button2)
+ (defvar mouse-button-3 'button3)
+ )
+ ((>= emacs-major-version 19)
+ ;; for tm-7.106
+ (defalias 'tl:make-overlay 'make-overlay)
+ (defalias 'tl:overlay-put 'overlay-put)
+ (defalias 'tl:overlay-buffer 'overlay-buffer)
+
+ (make-obsolete 'tl:make-overlay 'make-overlay)
+ (make-obsolete 'tl:overlay-put 'overlay-put)
+ (make-obsolete 'tl:overlay-buffer 'overlay-buffer)
+
+ ;; mouse
+ (defvar mouse-button-1 [mouse-1])
+ (defvar mouse-button-2 [mouse-2])
+ (defvar mouse-button-3 [down-mouse-3])
+ )
+ (t
+ ;; mouse
+ (defvar mouse-button-1 nil)
+ (defvar mouse-button-2 nil)
+ (defvar mouse-button-3 nil)
+ ))
+
+(cond (running-xemacs
(if (featurep 'mule)
;; for XEmacs with MULE
(require 'emu-x20)
)
(t
;; for Emacs 19
- (require 'emu-e19)
(require 'emu-latin1)
))
--- /dev/null
+;;; poe-18.el --- poe API implementation for Emacs 18.*
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(autoload 'setenv "env"
+ "Set the value of the environment variable named VARIABLE to VALUE.
+VARIABLE should be a string. VALUE is optional; if not provided or is
+`nil', the environment variable VARIABLE will be removed.
+This function works by modifying `process-environment'."
+ t)
+
+(defvar data-directory exec-directory)
+
+
+;;; @ for EMACS 18.55
+;;;
+
+(defvar buffer-undo-list nil)
+
+
+;;; @ hook
+;;;
+
+;; These function are imported from EMACS 19.28.
+(defun add-hook (hook function &optional append)
+ "Add to the value of HOOK the function FUNCTION.
+FUNCTION is not added if already present.
+FUNCTION is added (if necessary) at the beginning of the hook list
+unless the optional argument APPEND is non-nil, in which case
+FUNCTION is added at the end.
+
+HOOK should be a symbol, and FUNCTION may be any valid function. If
+HOOK is void, it is first set to nil. If HOOK's value is a single
+function, it is changed to a list of functions.
+\[poe-18.el; EMACS 19 emulating function]"
+ (or (boundp hook)
+ (set hook nil)
+ )
+ ;; If the hook value is a single function, turn it into a list.
+ (let ((old (symbol-value hook)))
+ (if (or (not (listp old))
+ (eq (car old) 'lambda))
+ (set hook (list old))
+ ))
+ (or (if (consp function)
+ ;; Clever way to tell whether a given lambda-expression
+ ;; is equal to anything in the hook.
+ (let ((tail (assoc (cdr function) (symbol-value hook))))
+ (equal function tail)
+ )
+ (memq function (symbol-value hook))
+ )
+ (set hook
+ (if append
+ (nconc (symbol-value hook) (list function))
+ (cons function (symbol-value hook))
+ ))
+ ))
+
+(defun remove-hook (hook function)
+ "Remove from the value of HOOK the function FUNCTION.
+HOOK should be a symbol, and FUNCTION may be any valid function. If
+FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
+list of hooks to run in HOOK, then nothing is done. See `add-hook'.
+\[poe-18.el; EMACS 19 emulating function]"
+ (if (or (not (boundp hook)) ;unbound symbol, or
+ (null (symbol-value hook)) ;value is nil, or
+ (null function)) ;function is nil, then
+ nil ;Do nothing.
+ (let ((hook-value (symbol-value hook)))
+ (if (consp hook-value)
+ (setq hook-value (delete function hook-value))
+ (if (equal hook-value function)
+ (setq hook-value nil)
+ ))
+ (set hook hook-value)
+ )))
+
+
+;;; @ list
+;;;
+
+(defun member (elt list)
+ "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL.
+The value is actually the tail of LIST whose car is ELT.
+\[poe-18.el; EMACS 19 emulating function]"
+ (while (and list (not (equal elt (car list))))
+ (setq list (cdr list)))
+ list)
+
+(defun delete (elt list)
+ "Delete by side effect any occurrences of ELT as a member of LIST.
+The modified LIST is returned. Comparison is done with `equal'.
+If the first member of LIST is ELT, deleting it is not a side effect;
+it is simply using a different list.
+Therefore, write `(setq foo (delete element foo))'
+to be sure of changing the value of `foo'.
+\[poe-18.el; EMACS 19 emulating function]"
+ (if (equal elt (car list))
+ (cdr list)
+ (let ((rest list)
+ (rrest (cdr list))
+ )
+ (while (and rrest (not (equal elt (car rrest))))
+ (setq rest rrest
+ rrest (cdr rrest))
+ )
+ (rplacd rest (cdr rrest))
+ list)))
+
+
+;;; @ function
+;;;
+
+(defun defalias (sym newdef)
+ "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.
+Associates the function with the current load file, if any.
+\[poe-18.el; EMACS 19 emulating function]"
+ (fset sym newdef)
+ )
+
+(defun byte-code-function-p (exp)
+ "T if OBJECT is a byte-compiled function object.
+\[poe-18.el; EMACS 19 emulating function]"
+ (and (consp exp)
+ (let* ((rest (cdr (cdr exp))) elt)
+ (if (stringp (car rest))
+ (setq rest (cdr rest))
+ )
+ (catch 'tag
+ (while rest
+ (setq elt (car rest))
+ (if (and (consp elt)(eq (car elt) 'byte-code))
+ (throw 'tag t)
+ )
+ (setq rest (cdr rest))
+ ))
+ )))
+
+(defmacro-maybe defsubst (name arglist &rest body)
+ "Define an inline function. The syntax is just like that of `defun'."
+ (cons 'defun (cons name (cons arglist body)))
+ )
+
+
+;;; @ file
+;;;
+
+(defun make-directory-internal (dirname)
+ "Create a directory. One argument, a file name string.
+\[poe-18.el; EMACS 19 emulating function]"
+ (if (file-exists-p dirname)
+ (error "Creating directory: %s is already exist" dirname)
+ (if (not (= (call-process "mkdir" nil nil nil dirname) 0))
+ (error "Creating directory: no such file or directory, %s" dirname)
+ )))
+
+(defun make-directory (dir &optional parents)
+ "Create the directory DIR and any nonexistent parent dirs.
+The second (optional) argument PARENTS says whether
+to create parent directories if they don't exist.
+\[poe-18.el; EMACS 19 emulating function]"
+ (let ((len (length dir))
+ (p 0) p1 path)
+ (catch 'tag
+ (while (and (< p len) (string-match "[^/]*/?" dir p))
+ (setq p1 (match-end 0))
+ (if (= p1 len)
+ (throw 'tag nil)
+ )
+ (setq path (substring dir 0 p1))
+ (if (not (file-directory-p path))
+ (cond ((file-exists-p path)
+ (error "Creating directory: %s is not directory" path)
+ )
+ ((null parents)
+ (error "Creating directory: %s is not exist" path)
+ )
+ (t
+ (make-directory-internal path)
+ ))
+ )
+ (setq p p1)
+ ))
+ (make-directory-internal dir)
+ ))
+
+;; Imported from files.el of EMACS 19.33.
+(defun parse-colon-path (cd-path)
+ "Explode a colon-separated list of paths into a string list."
+ (and cd-path
+ (let (cd-prefix cd-list (cd-start 0) cd-colon)
+ (setq cd-path (concat cd-path path-separator))
+ (while (setq cd-colon (string-match path-separator cd-path cd-start))
+ (setq cd-list
+ (nconc cd-list
+ (list (if (= cd-start cd-colon)
+ nil
+ (substitute-in-file-name
+ (file-name-as-directory
+ (substring cd-path cd-start cd-colon)))))))
+ (setq cd-start (+ cd-colon 1)))
+ cd-list)))
+
+;; Imported from files.el of EMACS 19.33.
+(defun file-relative-name (filename &optional directory)
+ "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
+ (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)))))
+
+(or (fboundp 'si:directory-files)
+ (fset 'si:directory-files (symbol-function 'directory-files)))
+(defun directory-files (directory &optional full match nosort)
+ "Return a list of names of files in DIRECTORY.
+There are three optional arguments:
+If FULL is non-nil, return absolute file names. Otherwise return names
+ that are relative to the specified directory.
+If MATCH is non-nil, mention only file names that match the regexp MATCH.
+If NOSORT is dummy for compatibility.
+\[poe-18.el; EMACS 19 emulating function]"
+ (si:directory-files directory full match)
+ )
+
+
+;;; @ mark
+;;;
+
+(or (fboundp 'si:mark)
+ (fset 'si:mark (symbol-function 'mark)))
+(defun mark (&optional force)
+ (si:mark)
+ )
+
+
+;;; @ mode-line
+;;;
+
+;;; Imported from Emacs 19.30.
+(defun force-mode-line-update (&optional all)
+ "Force the mode-line of the current buffer to be redisplayed.
+With optional non-nil ALL, force redisplay of all mode-lines.
+\[poe-18.el; Emacs 19 emulating function]"
+ (if all (save-excursion (set-buffer (other-buffer))))
+ (set-buffer-modified-p (buffer-modified-p)))
+
+
+;;; @ overlay
+;;;
+
+(defun overlay-buffer (overlay))
+
+
+;;; @ text property
+;;;
+
+(defun remove-text-properties (start end properties &optional object))
+
+
+;;; @@ visible/invisible
+;;;
+
+(defmacro enable-invisible ()
+ (`
+ (progn
+ (make-local-variable 'original-selective-display)
+ (setq original-selective-display selective-display)
+ (setq selective-display t)
+ )))
+
+(defmacro end-of-invisible ()
+ (` (setq selective-display
+ (if (boundp 'original-selective-display)
+ original-selective-display))
+ ))
+
+(defun invisible-region (start end)
+ (let ((buffer-read-only nil) ;Okay even if write protected.
+ (modp (buffer-modified-p)))
+ (if (save-excursion
+ (goto-char (1- end))
+ (eq (following-char) ?\n)
+ )
+ (setq end (1- end))
+ )
+ (unwind-protect
+ (subst-char-in-region start end ?\n ?\^M t)
+ (set-buffer-modified-p modp)
+ )))
+
+(defun visible-region (start end)
+ (let ((buffer-read-only nil) ;Okay even if write protected.
+ (modp (buffer-modified-p)))
+ (unwind-protect
+ (subst-char-in-region start end ?\^M ?\n t)
+ (set-buffer-modified-p modp)
+ )))
+
+(defun invisible-p (pos)
+ (save-excursion
+ (goto-char pos)
+ (eq (following-char) ?\^M)
+ ))
+
+(defun next-visible-point (pos)
+ (save-excursion
+ (goto-char pos)
+ (end-of-line)
+ (if (eq (following-char) ?\n)
+ (forward-char)
+ )
+ (point)
+ ))
+
+
+;;; @ string
+;;;
+
+(defun char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string. [poe-18.el]"
+ (mapconcat (function char-to-string) char-list "")
+ )
+
+
+;;; @ buffer
+;;;
+
+(defun-maybe generate-new-buffer-name (name &optional ignore)
+ "Return a string that is the name of no existing buffer based on NAME.
+If there is no live buffer named NAME, then return NAME.
+Otherwise modify name by appending `<NUMBER>', incrementing NUMBER
+until an unused name is found, and then return that name.
+Optional second argument IGNORE specifies a name that is okay to use
+\(if it is in the sequence to be tried)
+even if a buffer with that name exists."
+ (if (get-buffer name)
+ (let ((n 2) new)
+ (while (get-buffer (setq new (format "%s<%d>" name n)))
+ (setq n (1+ n)))
+ new)
+ name))
+
+
+;;; @ end
+;;;
+
+(provide 'poe-18)
+
+;;; poe-18.el ends here
--- /dev/null
+;;; poe-19.el --- poe API implementation for Emacs 19.*
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;; @ face
+;;;
+
+(defun-maybe find-face (face)
+ (car (memq face (face-list)))
+ )
+
+
+;;; @ visible/invisible
+;;;
+
+(defmacro enable-invisible ())
+
+(defmacro end-of-invisible ())
+
+(defun invisible-region (start end)
+ (if (save-excursion
+ (goto-char (1- end))
+ (eq (following-char) ?\n)
+ )
+ (setq end (1- end))
+ )
+ (put-text-property start end 'invisible t)
+ )
+
+(defun visible-region (start end)
+ (put-text-property start end 'invisible nil)
+ )
+
+(defun invisible-p (pos)
+ (get-text-property pos 'invisible)
+ )
+
+(defun next-visible-point (pos)
+ (save-excursion
+ (goto-char (next-single-property-change pos 'invisible))
+ (if (eq (following-char) ?\n)
+ (forward-char)
+ )
+ (point)))
+
+
+;;; @ string
+;;;
+
+(defmacro char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string."
+ (` (mapconcat (function char-to-string)
+ (, char-list)
+ "")))
+
+
+;;; @ end
+;;;
+
+(provide 'poe-19)
+
+;;; poe-19.el ends here
--- /dev/null
+;;; poe-xemacs.el --- poe API implementation for XEmacs
+
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, XEmacs
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; 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.
+
+;; You should have received a copy of the GNU General Public License
+;; 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:
+
+;;; @ face
+;;;
+
+(or (fboundp 'face-list)
+ (defalias 'face-list 'list-faces))
+
+(or (memq 'underline (face-list))
+ (and (fboundp 'make-face)
+ (make-face 'underline)))
+
+(or (face-differs-from-default-p 'underline)
+ (set-face-underline-p 'underline t))
+
+
+;;; @ overlay
+;;;
+
+(condition-case nil
+ (require 'overlay)
+ (error (defalias 'make-overlay 'make-extent)
+ (defalias 'overlay-put 'set-extent-property)
+ (defalias 'overlay-buffer 'extent-buffer)
+ (defun move-overlay (extent start end &optional buffer)
+ (set-extent-endpoints extent start end)
+ )
+ ))
+
+
+;;; @ visible/invisible
+;;;
+
+(defmacro enable-invisible ())
+
+(defmacro end-of-invisible ())
+
+(defun invisible-region (start end)
+ (if (save-excursion
+ (goto-char start)
+ (eq (following-char) ?\n))
+ (setq start (1+ start))
+ )
+ (put-text-property start end 'invisible t)
+ )
+
+(defun visible-region (start end)
+ (put-text-property start end 'invisible nil)
+ )
+
+(defun invisible-p (pos)
+ (if (save-excursion
+ (goto-char pos)
+ (eq (following-char) ?\n))
+ (setq pos (1+ pos))
+ )
+ (get-text-property pos 'invisible)
+ )
+
+(defun next-visible-point (pos)
+ (save-excursion
+ (if (save-excursion
+ (goto-char pos)
+ (eq (following-char) ?\n))
+ (setq pos (1+ pos))
+ )
+ (or (next-single-property-change pos 'invisible)
+ (point-max))))
+
+
+;;; @ dired
+;;;
+
+(or (fboundp 'dired-other-frame)
+ (defun dired-other-frame (dirname &optional switches)
+ "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
+ (interactive (dired-read-dir-and-switches "in other frame "))
+ (switch-to-buffer-other-frame (dired-noselect dirname switches)))
+ )
+
+
+;;; @ string
+;;;
+
+(defmacro char-list-to-string (char-list)
+ "Convert list of character CHAR-LIST to string. [poe-xemacs.el]"
+ `(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). [poe-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
+;;;
+
+(provide 'poe-xemacs)
+
+;;; poe-xemacs.el ends here
--- /dev/null
+;;; poe.el --- Emulation module for each Emacs variants
+
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
+
+;; This file is part of APEL (A Portable Emacs Library).
+
+;; 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defmacro defun-maybe (name &rest everything-else)
+ (or (and (fboundp name)
+ (not (get name 'defun-maybe))
+ )
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (defun (, name) (,@ everything-else))
+ (put (quote (, name)) 'defun-maybe t)
+ ))
+ )))
+
+(defmacro defsubst-maybe (name &rest everything-else)
+ (or (and (fboundp name)
+ (not (get name 'defsubst-maybe))
+ )
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (defsubst (, name) (,@ everything-else))
+ (put (quote (, name)) 'defsubst-maybe t)
+ ))
+ )))
+
+(defmacro defmacro-maybe (name &rest everything-else)
+ (or (and (fboundp name)
+ (not (get name 'defmacro-maybe))
+ )
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (defmacro (, name) (,@ everything-else))
+ (put (quote (, name)) 'defmacro-maybe t)
+ ))
+ )))
+
+(put 'defun-maybe 'lisp-indent-function 'defun)
+(put 'defsubst-maybe 'lisp-indent-function 'defun)
+(put 'defmacro-maybe 'lisp-indent-function 'defun)
+
+(defmacro defconst-maybe (name &rest everything-else)
+ (or (and (boundp name)
+ (not (get name 'defconst-maybe))
+ )
+ (` (or (boundp (quote (, name)))
+ (progn
+ (defconst (, name) (,@ everything-else))
+ (put (quote (, name)) 'defconst-maybe t)
+ ))
+ )))
+
+(defconst-maybe emacs-major-version (string-to-int emacs-version))
+
+(cond ((featurep 'xemacs)
+ (require 'poe-xemacs)
+ )
+ ((string-match "XEmacs" emacs-version)
+ (provide 'xemacs)
+ (require 'poe-xemacs)
+ )
+ ((>= emacs-major-version 19)
+ (require 'poe-19)
+ )
+ (t
+ (require 'poe-18)
+ ))
+
+
+;;; @ end
+;;;
+
+(provide 'poe)
+
+;;; poe.el ends here
projects / elisp / apel.git / commitdiff