* static.el (static-defconst): New function.
[elisp/apel.git] / poe.el
diff --git a/poe.el b/poe.el
index f77d66b..39816a8 100644 (file)
--- a/poe.el
+++ b/poe.el
@@ -175,23 +175,37 @@ See also the function `defconst'."
        ;; XXX: should do compile-time and load-time check before loading
        ;;      "localhook".  But, it is difficult since "localhook" is
        ;;      already loaded via "install" at compile-time.  any idea?
-       (require 'localhook)
-       ))
+       (require 'localhook)))
 
-(eval-when-compile
-  (condition-case nil
-      (require 'edebug)
-    (error
-     (defmacro def-edebug-spec (symbol spec)
-       (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
-     ))
-  (require 'static)
-  )
+;;; `eval-when-compile' is defined in "poe-18" under v18 with old compiler.
+(eval-when-compile (require 'static))
+
+;; imported from emacs-20.3/lisp/emacs-lisp/edebug.el.
+;; `def-edebug-spec' is an autoloaded macro in v19 and later.
+(defmacro-maybe def-edebug-spec (symbol spec)
+  "Set the edebug-form-spec property of SYMBOL according to SPEC.
+Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
+\(naming a function\), or a list."
+  (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
 
 (def-edebug-spec defun-maybe defun)
 (def-edebug-spec defmacro-maybe defmacro)
 (def-edebug-spec defsubst-maybe defun)
 
+;;; Emacs 20.1 emulation
+
+;; imported from emacs-20.3/lisp/subr.el.
+(defmacro-maybe when (cond &rest body)
+  "If COND yields non-nil, do BODY, else return nil."
+  (list 'if cond (cons 'progn body)))
+;; (def-edebug-spec when (&rest form))
+
+;; imported from emacs-20.3/lisp/subr.el.
+(defmacro-maybe unless (cond &rest body)
+  "If COND yields nil, do BODY, else return nil."
+  (cons 'if (cons cond (cons nil body))))
+;; (def-edebug-spec unless (&rest form))
+
 
 ;;; @ Emacs 19.23 emulation
 ;;;
@@ -202,6 +216,7 @@ See also the function `defconst'."
     (set-buffer (window-buffer (minibuffer-window)))
     (current-column)))
 
+
 ;;; @ Emacs 19.29 emulation
 ;;;
 
@@ -270,6 +285,7 @@ The extension, in a file name, is the part that follows the last `.'.
            (substring file 0 (match-beginning 0)))
        filename))))
 
+
 ;;; @ Emacs 19.30 emulation
 ;;;
 
@@ -331,16 +347,6 @@ Value is nil if OBJECT is not a buffer or if it has been killed.
 ;;;
 
 ;; imported from emacs-20.3/lisp/subr.el.
-(defmacro-maybe when (cond &rest body)
-  "If COND yields non-nil, do BODY, else return nil."
-  (list 'if cond (cons 'progn body)))
-
-;; imported from emacs-20.3/lisp/subr.el.
-(defmacro-maybe unless (cond &rest body)
-  "If COND yields nil, do BODY, else return nil."
-  (cons 'if (cons cond (cons nil body))))
-
-;; imported from emacs-20.3/lisp/subr.el.
 (defsubst-maybe caar (x)
   "Return the car of the car of X."
   (car (car x)))
@@ -469,6 +475,140 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
            start (match-end 0)))
     (nreverse (cons (substring string start) parts))))
 
+;; emulating char-before of Emacs 20.
+(static-condition-case nil
+    ;; compile-time check.
+    (progn
+      ;; XXX: this file is already loaded at compile-time,
+      ;; so this test will always success.
+      (char-before)
+      ;; If our definition is found at compile-time, signal an error.
+      ;; XXX: should signal more specific error. 
+      (if (get 'char-before 'defun-maybe)
+          (error "")))
+  (wrong-number-of-arguments            ; Mule 1.*, 2.*.
+   ;; load-time check.
+   (or (fboundp 'si:char-before)
+       (progn
+         (fset 'si:char-before (symbol-function 'char-before))
+         (put 'char-before 'defun-maybe t)
+         ;; takes IGNORED for backward compatibility.
+         (defun char-before (&optional pos ignored)
+           "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+           (si:char-before (or pos (point)))))))
+  (void-function                        ; non-Mule.
+   ;; load-time check.
+   (defun-maybe char-before (&optional pos)
+     "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+     (if pos
+         (save-excursion
+           (and (= (goto-char pos) (point))
+                (not (bobp))
+                (preceding-char)))
+       (and (not (bobp))
+            (preceding-char)))))
+  (error                                ; found our definition at compile-time.
+   ;; load-time check.
+   (condition-case nil
+       (char-before)
+     (wrong-number-of-arguments         ; Mule 1.*, 2.*.
+      (or (fboundp 'si:char-before)
+          (progn
+            (fset 'si:char-before (symbol-function 'char-before))
+            (put 'char-before 'defun-maybe t)
+            ;; takes IGNORED for backward compatibility.
+            (defun char-before (&optional pos ignored)
+              "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+              (si:char-before (or pos (point)))))))
+     (void-function                     ; non-Mule.
+      (defun-maybe char-before (&optional pos)
+        "\
+Return character in current buffer preceding position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+        (if pos
+            (save-excursion
+              (and (= (goto-char pos) (point))
+                   (not (bobp))
+                   (preceding-char)))
+          (and (not (bobp))
+               (preceding-char))))))))
+
+;; emulating char-after of Emacs 20.
+(static-condition-case nil
+    ;; compile-time check.
+    (progn
+      ;; XXX: this file is already loaded at compile-time,
+      ;; so this test will always success.
+      (char-after)
+      ;; If our definition is found at compile-time, signal an error.
+      ;; XXX: should signal more specific error. 
+      (if (get 'char-after 'defun-maybe)
+          (error "")))
+  (wrong-number-of-arguments           ; v18, v19
+   ;; load-time check.
+   (or (fboundp 'si:char-after)
+       (progn
+         (fset 'si:char-after (symbol-function 'char-after))
+         (put 'char-after 'defun-maybe t)
+         (defun char-after (&optional pos)
+           "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+           (si:char-after (or pos (point)))))))
+  (void-function                       ; NEVER happen?
+   ;; load-time check.
+   (defun-maybe char-after (&optional pos)
+     "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+     (if pos
+         (save-excursion
+           (and (= (goto-char pos) (point))
+                (not (eobp))
+                (following-char)))
+       (and (not (eobp))
+            (following-char)))))
+  (error                                ; found our definition at compile-time.
+   ;; load-time check.
+   (condition-case nil
+       (char-after)
+     (wrong-number-of-arguments         ; v18, v19
+      (or (fboundp 'si:char-after)
+          (progn
+            (fset 'si:char-after (symbol-function 'char-after))
+            (put 'char-after 'defun-maybe t)
+           (defun char-after (&optional pos)
+             "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+             (si:char-after (or pos (point)))))))
+     (void-function                     ; NEVER happen?
+      (defun-maybe char-after (&optional pos)
+       "\
+Return character in current buffer at position POS.
+POS is an integer or a buffer pointer.
+If POS is out of range, the value is nil."
+       (if pos
+           (save-excursion
+             (and (= (goto-char pos) (point))
+                  (not (eobp))
+                  (following-char)))
+         (and (not (eobp))
+              (following-char))))))))
+
 
 ;;; @ Emacs 20.3 emulation
 ;;;
@@ -574,7 +714,7 @@ Note that CH (the keystroke specifier) can be an integer, a character
 or a symbol such as 'clear. [XEmacs emulating function]"
     ch)
 
-  (defun-maybe event-to-character (event)
+  (defsubst-maybe event-to-character (event)
     "Return the character approximation to the given event object.
 If the event isn't a keypress, this returns nil.
 \[XEmacs emulating function]"
@@ -586,8 +726,7 @@ If the event isn't a keypress, this returns nil.
                   (if base
                       (logior base (car (cdr mask)))
                     )))))
-         ((integerp event) event)
-         ))
+         ((integerp event) event)))
   )