From 9eb205044093a93d5561a5278660db81a2500bd1 Mon Sep 17 00:00:00 2001 From: morioka Date: Thu, 17 Sep 1998 05:58:23 +0000 Subject: [PATCH] - Split core part into poe.el from emu.el. - Rename emu-18.el -> poe-18.el, emu-e19.el -> poe-19.el, emu-xemacs.el -> poe-xemacs.el. --- EMU-ELS | 25 ++-- emu-18.el | 385 --------------------------------------------------------- emu-e19.el | 104 ---------------- emu-e20.el | 2 +- emu-mule.el | 5 +- emu-nemacs.el | 2 +- emu-xemacs.el | 154 ----------------------- emu.el | 81 +++++------- poe-18.el | 376 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ poe-19.el | 84 +++++++++++++ poe-xemacs.el | 142 +++++++++++++++++++++ poe.el | 97 +++++++++++++++ 12 files changed, 744 insertions(+), 713 deletions(-) delete mode 100644 emu-18.el delete mode 100644 emu-e19.el delete mode 100644 emu-xemacs.el create mode 100644 poe-18.el create mode 100644 poe-19.el create mode 100644 poe-xemacs.el create mode 100644 poe.el diff --git a/EMU-ELS b/EMU-ELS index 17d9275..a3050ef 100644 --- a/EMU-ELS +++ b/EMU-ELS @@ -5,19 +5,18 @@ ;;; 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 @@ -30,22 +29,22 @@ '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)) diff --git a/emu-18.el b/emu-18.el deleted file mode 100644 index 8ee121a..0000000 --- a/emu-18.el +++ /dev/null @@ -1,385 +0,0 @@ -;;; emu-18.el --- emu API implementation for Emacs 18.* - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; 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 `', 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 diff --git a/emu-e19.el b/emu-e19.el deleted file mode 100644 index 66ca0b6..0000000 --- a/emu-e19.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; emu-e19.el --- emu API implementation for Emacs 19.* - -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; 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 diff --git a/emu-e20.el b/emu-e20.el index fe6659f..0fe2b47 100644 --- a/emu-e20.el +++ b/emu-e20.el @@ -28,7 +28,7 @@ ;;; Code: -(require 'emu-e19) +(require 'poe) (defun fontset-pixel-size (fontset) (let* ((info (fontset-info fontset)) diff --git a/emu-mule.el b/emu-mule.el index 8c4eb6c..59cc665 100644 --- a/emu-mule.el +++ b/emu-mule.el @@ -28,9 +28,9 @@ ;;; @ version specific features ;;; +(require 'poe) + (cond (running-emacs-19 - (require 'emu-e19) - ;; Suggested by SASAKI Osamu ;; (cf. [os2-emacs-ja:78]) (defun fontset-pixel-size (fontset) @@ -49,7 +49,6 @@ )))) ) (running-emacs-18 - (require 'emu-18) (defun make-overlay (beg end &optional buffer type)) (defun overlay-put (overlay prop value)) )) diff --git a/emu-nemacs.el b/emu-nemacs.el index 3b69644..6cdb4da 100644 --- a/emu-nemacs.el +++ b/emu-nemacs.el @@ -24,7 +24,7 @@ ;;; Code: -(require 'emu-18) +(require 'poe) ;;; @ character set diff --git a/emu-xemacs.el b/emu-xemacs.el deleted file mode 100644 index 7815219..0000000 --- a/emu-xemacs.el +++ /dev/null @@ -1,154 +0,0 @@ -;;; 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 -;; 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 diff --git a/emu.el b/emu.el index 2b07a12..5b3990a 100644 --- a/emu.el +++ b/emu.el @@ -24,56 +24,8 @@ ;;; 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 @@ -102,7 +54,33 @@ (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) @@ -123,7 +101,6 @@ ) (t ;; for Emacs 19 - (require 'emu-e19) (require 'emu-latin1) )) diff --git a/poe-18.el b/poe-18.el new file mode 100644 index 0000000..0386806 --- /dev/null +++ b/poe-18.el @@ -0,0 +1,376 @@ +;;; poe-18.el --- poe API implementation for Emacs 18.* + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 `', 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 diff --git a/poe-19.el b/poe-19.el new file mode 100644 index 0000000..62995e6 --- /dev/null +++ b/poe-19.el @@ -0,0 +1,84 @@ +;;; poe-19.el --- poe API implementation for Emacs 19.* + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 diff --git a/poe-xemacs.el b/poe-xemacs.el new file mode 100644 index 0000000..77ac80d --- /dev/null +++ b/poe-xemacs.el @@ -0,0 +1,142 @@ +;;; 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 +;; 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 diff --git a/poe.el b/poe.el new file mode 100644 index 0000000..d3e4d37 --- /dev/null +++ b/poe.el @@ -0,0 +1,97 @@ +;;; poe.el --- Emulation module for each Emacs variants + +;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; 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 -- 1.7.10.4