X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=poe-18.el;h=73403d15ffdd885e9c4aeb0fb3108e124e43a5b8;hb=7e9456b37ab33cf89832ddc09f28612c1745c2da;hp=c7f72dbed9cf77220ddb83b2dd70dacc2cb11dfb;hpb=84390eec3b7c659dad3799c31e5573a7e16f228e;p=elisp%2Fapel.git

diff --git a/poe-18.el b/poe-18.el
index c7f72db..73403d1 100644
--- a/poe-18.el
+++ b/poe-18.el
@@ -1,8 +1,8 @@
 ;;; poe-18.el --- poe API implementation for Emacs 18.*
 
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: emulation, compatibility
 
 ;; This file is part of APEL (A Portable Emacs Library).
@@ -18,97 +18,42 @@
 ;; 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
+;; 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.
 
-;;; Code:
+;;; Commentary:
 
-(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)
+;; Note to developers:
+;; 
+;; If old (v18) compiler is used, top-level macros are expanded at
+;; *load-time*, not compile-time.  So, you cannot use macros defined
+;; in this file using `defmacro-maybe'.  In addition, due to this
+;; limitation, `eval-when-compile' and `eval-and-compile' provided by
+;; this file do not do compile-time evaluation at all.
 
-(defvar data-directory exec-directory)
+;;; Code:
 
+(provide 'poe-18)			; beware of circular dependency.
+(require 'poe)				; load definitions of `*-maybe'.
 
 ;;; @ for EMACS 18.55
 ;;;
 
-(defvar buffer-undo-list nil)
+(defvar-maybe buffer-undo-list nil)
 
 
-;;; @ hook
+;;; @ Emacs 19 emulation
 ;;;
 
-;; 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
+(defvar-maybe data-directory exec-directory)
+
+
+;;; @ Lisp Language
 ;;;
 
-(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)
+;;; @@ list
+;;;
 
 (defun delete (elt list)
   "Delete by side effect any occurrences of ELT as a member of LIST.
@@ -118,64 +63,158 @@ 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
+  (if list
+      (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)))
+	  (setcdr rest (cdr rrest))
+	  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)
+
+
+;;; @@ buffer-local variable
+;;;
+
+(defun default-boundp (symbol)
+  "Return t if SYMBOL has a non-void default value.
+This is the value that is seen in buffers that do not have their own values
+for this variable.
+\[poe-18.el; EMACS 19 emulating function]"
+  (condition-case error
+      (progn
+	(default-value symbol)
+	t)
+    (void-variable nil)))
+
+
+;;; @@ environment variable
+;;;
+
+(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)
+
+
+;;; @@ 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)
-  )
+Associates the function with the current load file, if any."
+  (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)
+       (let ((rest (cdr (cdr exp)))
+	     elt)
 	 (if (stringp (car rest))
-	     (setq rest (cdr 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))
-	     ))
-	 )))
+	     (if (and (consp elt)
+		      (eq (car elt) 'byte-code))
+		 (throw 'tag t))
+	     (setq rest (cdr rest)))))))
 
+
+;;; @ Compilation Features
+;;;
+
+;;; emulate all functions and macros of emacs-20.3/lisp/byte-run.el.
+;;; (note: jwz's original compiler and XEmacs compiler have some more
+;;;  macros; they are "nuked" by rms in FSF version.)
+
+(put 'inline 'lisp-indent-hook 0)
+(defmacro inline (&rest body)
+  "Eval BODY forms sequentially and return value of last one.
+
+This emulating macro does not support function inlining because old \(v18\)
+compiler does not support inlining feature.
+\[poe-18.el; EMACS 19 emulating macro]"
+  (` (progn (,@ body))))
+
+(put 'defsubst 'lisp-indent-hook 'defun)
+(put 'defsubst 'edebug-form-spec 'defun)
 (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)))
-  )
+  "Define an inline function.  The syntax is just like that of `defun'.
+
+This emulating macro does not support function inlining because old \(v18\)
+compiler does not support inlining feature.
+\[poe-18.el; EMACS 19 emulating macro]"
+  (cons 'defun (cons name (cons arglist body))))
 
 (defun-maybe make-obsolete (fn new)
   "Make the byte-compiler warn that FUNCTION is obsolete.
 The warning will say that NEW should be used instead.
-If NEW is a string, that is the `use instead' message."
+If NEW is a string, that is the `use instead' message.
+
+This emulating function does nothing because old \(v18\) compiler does not
+support this feature.
+\[poe-18.el; EMACS 19 emulating function]"
   (interactive "aMake function obsolete: \nxObsoletion replacement: ")
-  (let ((handler (get fn 'byte-compile)))
-    (if (eq 'byte-compile-obsolete handler)
-	(setcar (get fn 'byte-obsolete-info) new)
-      (put fn 'byte-obsolete-info (cons new handler))
-      (put fn 'byte-compile 'byte-compile-obsolete)))
   fn)
 
+(defun-maybe make-obsolete-variable (var new)
+  "Make the byte-compiler warn that VARIABLE is obsolete,
+and NEW should be used instead.  If NEW is a string, then that is the
+`use instead' message.
+
+This emulating function does nothing because old \(v18\) compiler does not
+support this feature.
+\[poe-18.el; EMACS 19 emulating function]"
+  (interactive "vMake variable obsolete: \nxObsoletion replacement: ")
+  var)
+
+(put 'dont-compile 'lisp-indent-hook 0)
+(defmacro-maybe dont-compile (&rest body)
+  "Like `progn', but the body always runs interpreted \(not compiled\).
+If you think you need this, you're probably making a mistake somewhere.
+\[poe-18.el; EMACS 19 emulating macro]"
+  (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body)))))
+
+(put 'eval-when-compile 'lisp-indent-hook 0)
+(defmacro-maybe eval-when-compile (&rest body)
+  "Like progn, but evaluates the body at compile-time.
+
+This emulating macro does not do compile-time evaluation at all because
+of the limitation of old \(v18\) compiler.
+\[poe-18.el; EMACS 19 emulating macro]"
+  (cons 'progn body))
+
+(put 'eval-and-compile 'lisp-indent-hook 0)
+(defmacro-maybe eval-and-compile (&rest body)
+  "Like progn, but evaluates the body at compile-time as well as at load-time.
+
+This emulating macro does not do compile-time evaluation at all because
+of the limitation of old \(v18\) compiler.
+\[poe-18.el; EMACS 19 emulating macro]"
+  (cons 'progn body))
+
+
+;;; @ text property
+;;;
+
+(defun set-text-properties (start end properties &optional object))
+
+(defun remove-text-properties (start end properties &optional object))
+
 
 ;;; @ file
 ;;;
@@ -183,11 +222,10 @@ If NEW is a string, that is the `use instead' message."
 (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)
-      )))
+ (let ((dir (expand-file-name dirname)))
+   (if (file-exists-p dir)
+       (error "Creating directory: %s is already exist" dir)
+     (call-process "mkdir" nil nil nil dir))))
 
 (defun make-directory (dir &optional parents)
   "Create the directory DIR and any nonexistent parent dirs.
@@ -200,24 +238,17 @@ to create parent directories if they don't exist.
       (while (and (< p len) (string-match "[^/]*/?" dir p))
 	(setq p1 (match-end 0))
 	(if (= p1 len)
-	    (throw 'tag nil)
-	  )
+	    (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)
-		   )
+		   (error "Creating directory: %s is not directory" path))
 		  ((null parents)
-		   (error "Creating directory: %s is not exist" path)
-		   )
+		   (error "Creating directory: %s is not exist" path))
 		  (t
-		   (make-directory-internal path)
-		   ))
-	  )
-	(setq p p1)
-	))
-    (make-directory-internal dir)
-    ))
+		   (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)
@@ -229,7 +260,7 @@ to create parent directories if they don't exist.
 	   (setq cd-list
 		 (nconc cd-list
 			(list (if (= cd-start cd-colon)
-				   nil
+				  nil
 				(substitute-in-file-name
 				 (file-name-as-directory
 				  (substring cd-path cd-start cd-colon)))))))
@@ -258,21 +289,10 @@ If FULL is non-nil, return absolute file names.  Otherwise return names
 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)
-  )
+  (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
+;;; @ Display Features
 ;;;
 
 ;;; Imported from Emacs 19.30.
@@ -339,29 +359,17 @@ With optional non-nil ALL, force redisplay of all mode-lines.
 
        (defun overlay-put (overlay prop value)
 	 (let ((ret (and (eq prop 'face)
-			 (assq value emu:available-face-attribute-alist)
-			 )))
+			 (assq value emu:available-face-attribute-alist))))
 	   (if ret
 	       (attribute-add-narrow-attribute (cdr ret)
-					       (car overlay)(cdr overlay))
-	     )))
-       )
+					       (car overlay)(cdr overlay))))))
       (t
        (defun make-overlay (beg end &optional buffer type))
-       (defun overlay-put (overlay prop value))
-       ))
+       (defun overlay-put (overlay prop value))))
 
 (defun overlay-buffer (overlay))
 
 
-;;; @ text property
-;;;
-
-(defun set-text-properties (start end properties &optional object))
-
-(defun remove-text-properties (start end properties &optional object))
-
-
 ;;; @ buffer
 ;;;
 
@@ -380,10 +388,13 @@ even if a buffer with that name exists."
 	new)
     name))
 
+(or (fboundp 'si:mark)
+    (fset 'si:mark (symbol-function 'mark)))
+(defun mark (&optional force)
+  (si:mark))
+
 
 ;;; @ end
 ;;;
 
-(provide 'poe-18)
-
 ;;; poe-18.el ends here