X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=poe.el;h=5fdbdcccef524e2d65fd1af6c64ab40f456b31d9;hb=58967d4ba4497a5c2656c01ee4b5b3088cb628d2;hp=ec251242a7bc2b861a0a16031aae530927e19958;hpb=6a817e3f776bb9a6879ee98d399aa55e7ca16bcc;p=elisp%2Fapel.git

diff --git a/poe.el b/poe.el
index ec25124..5fdbdcc 100644
--- a/poe.el
+++ b/poe.el
@@ -39,23 +39,28 @@
 	       ))
 	 )))
 
-(defmacro defsubst-maybe (name &rest everything-else)
+(defmacro defmacro-maybe (name &rest everything-else)
   (or (and (fboundp name)
-	   (not (get name 'defsubst-maybe)))
+	   (not (get name 'defmacro-maybe)))
       (` (or (fboundp (quote (, name)))
 	     (progn
-	       (defsubst (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defsubst-maybe t)
+	       (defmacro (, name) (,@ everything-else))
+	       (put (quote (, name)) 'defmacro-maybe t)
 	       ))
 	 )))
 
-(defmacro defmacro-maybe (name &rest everything-else)
+(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)))
+  )
+
+(defmacro defsubst-maybe (name &rest everything-else)
   (or (and (fboundp name)
-	   (not (get name 'defmacro-maybe)))
+	   (not (get name 'defsubst-maybe)))
       (` (or (fboundp (quote (, name)))
 	     (progn
-	       (defmacro (, name) (,@ everything-else))
-	       (put (quote (, name)) 'defmacro-maybe t)
+	       (defsubst (, name) (,@ everything-else))
+	       (put (quote (, name)) 'defsubst-maybe t)
 	       ))
 	 )))
 
@@ -95,6 +100,33 @@
 	       ))
 	 )))
 
+(defmacro defun-maybe-cond (name args &optional doc &rest everything-else)
+  (unless (stringp doc)
+    (setq everything-else (cons doc everything-else)
+	  doc nil)
+    )
+  (or (and (fboundp name)
+	   (not (get name 'defun-maybe)))
+      (` (unless (fboundp (quote (, name)))
+	   (cond (,@ (mapcar (function
+			      (lambda (case)
+				(list (car case)
+				      (if doc
+					  (` (defun (, name) (, args)
+					       (, doc)
+					       (,@ (cdr case))))
+					(` (defun (, name) (, args)
+					     (,@ (cdr case))))
+					))))
+			     everything-else)))
+	   (put (quote (, name)) 'defun-maybe t)
+	   ))))
+
+(defsubst subr-fboundp (symbol)
+  "Return t if SYMBOL's function definition is a built-in function."
+  (and (fboundp symbol)
+       (subrp (symbol-function symbol))))
+
 (defconst-maybe emacs-major-version (string-to-int emacs-version))
 (defconst-maybe emacs-minor-version
   (string-to-int
@@ -111,10 +143,10 @@
        )
       ((> emacs-major-version 20))
       ((= emacs-major-version 20)
-       (cond ((fboundp 'string)
+       (cond ((subr-fboundp 'string)
 	      ;; Emacs 20.3 or later
 	      )
-	     ((fboundp 'concat-chars)
+	     ((subr-fboundp 'concat-chars)
 	      ;; Emacs 20.1 or later
 	      (defalias 'string 'concat-chars)
 	      ))
@@ -125,14 +157,9 @@
        ))
 
 
-;;; @ Emacs 19 emulation
+;;; @ Emacs 19.23 emulation
 ;;;
 
-(defmacro-maybe eval-and-compile (&rest body)
-  "Like `progn', but evaluates the body at compile time and at load time."
-  ;; Remember, it's magic.
-  (cons 'progn body))
-
 (defun-maybe minibuffer-prompt-width ()
   "Return the display width of the minibuffer prompt."
   (save-excursion
@@ -193,19 +220,32 @@ The value is actually the element of LIST whose cdr equals KEY."
       (setq list (cdr list)))
     ))
 
+(defun-maybe file-name-sans-extension (filename)
+  "Return FILENAME sans final \"extension\".
+The extension, in a file name, is the part that follows the last `.'."
+  (save-match-data
+    (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
+	  directory)
+      (if (string-match "\\.[^.]*\\'" file)
+	  (if (setq directory (file-name-directory filename))
+	      (expand-file-name (substring file 0 (match-beginning 0))
+				directory)
+	    (substring file 0 (match-beginning 0)))
+	filename))))
+
 (defmacro-maybe make-local-hook (hook))
 
 ;; They are not Emacs features
 
 (defmacro-maybe add-local-hook (hook function &optional append)
   (if (fboundp 'make-local-hook)
-      (list 'add-hook hook function append 'local)
+      (list 'add-hook hook function append t)
     (list 'add-hook hook function append)
     ))
 
-(defmacro remove-local-hook (hook function)
+(defmacro-maybe remove-local-hook (hook function)
   (if (fboundp 'make-local-hook)
-      (list 'remove-hook hook function 'local)
+      (list 'remove-hook hook function t)
     (list 'remove-hook hook function)
     ))
 
@@ -276,6 +316,22 @@ Value is nil if OBJECT is not a buffer or if it has been killed.
   "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
   (cons 'if (cons cond (cons nil body))))
 
+;; imported from Emacs 20.3.
+(defun-maybe last (x &optional n)
+  "Return the last link of the list X.  Its car is the last element.
+If X is nil, return nil.
+If N is non-nil, return the Nth-to-last link of X.
+If N is bigger than the length of X, return X."
+  (if n
+      (let ((m 0) (p x))
+	(while (consp p)
+	  (setq m (1+ m) p (cdr p)))
+	(if (<= n 0) p
+	  (if (< n m) (nthcdr (- m n) x) x)))
+    (while (cdr x)
+      (setq x (cdr x)))
+    x))
+
 (defmacro-maybe save-current-buffer (&rest body)
   "Save the current buffer; execute BODY; restore the current buffer.
 Executes BODY just like `progn'."
@@ -326,21 +382,9 @@ See also `with-temp-file' and `with-output-to-string'."
 	   (and (buffer-name (, temp-buffer))
 		(kill-buffer (, temp-buffer))))))))
 
-;; imported from Emacs 20.3.
-(defun-maybe last (x &optional n)
-  "Return the last link of the list X.  Its car is the last element.
-If X is nil, return nil.
-If N is non-nil, return the Nth-to-last link of X.
-If N is bigger than the length of X, return X."
-  (if n
-      (let ((m 0) (p x))
-	(while (consp p)
-	  (setq m (1+ m) p (cdr p)))
-	(if (<= n 0) p
-	  (if (< n m) (nthcdr (- m n) x) x)))
-    (while (cdr x)
-      (setq x (cdr x)))
-    x))
+(defmacro-maybe combine-after-change-calls (&rest body)
+  "Execute BODY."
+  (cons 'progn body))
 
 ;; imported from Emacs 20.3. (cl function)
 (defun-maybe butlast (x &optional n)
@@ -470,6 +514,65 @@ as obsolete. [XEmacs emulating function]"
   (make-obsolete oldfun newfun)
   )
 
+(when (subr-fboundp 'read-event)
+  ;; for Emacs 19 or later
+
+  (defun-maybe-cond next-command-event (&optional event prompt)
+    "Read an event object from the input stream.
+If EVENT is non-nil, it should be an event object and will be filled
+in and returned; otherwise a new event object will be created and
+returned.
+If PROMPT is non-nil, it should be a string and will be displayed in
+the echo area while this function is waiting for an event.
+\[XEmacs emulating function]"
+    ((subr-fboundp 'string)
+     ;; for Emacs 20.3 or later
+     (read-event prompt t)
+     )
+    (t
+     (if prompt (message prompt))
+     (read-event)
+     ))
+
+  (defsubst-maybe character-to-event (ch)
+    "Convert keystroke CH into an event structure, replete with bucky bits.
+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)
+    "Return the character approximation to the given event object.
+If the event isn't a keypress, this returns nil.
+\[XEmacs emulating function]"
+    (cond ((symbolp event)
+	   ;; mask is (BASE-TYPE MODIFIER-BITS) or nil.
+	   (let ((mask (get event 'event-symbol-element-mask)))
+	     (if mask
+		 (let ((base (get (car mask) 'ascii-character)))
+		   (if base
+		       (logior base (car (cdr mask)))
+		     )))))
+	  ((integerp event) event)
+	  ))
+  )
+
+
+;;; @ MULE 2 emulation
+;;;
+
+(defun-maybe-cond cancel-undo-boundary ()
+  "Cancel undo boundary. [MULE 2.3 emulating function]"
+  ((boundp 'buffer-undo-list)
+   ;; for Emacs 19.7 or later
+   (if (and (consp buffer-undo-list)
+	    ;; if car is nil.
+	    (null (car buffer-undo-list)))
+       (setq buffer-undo-list (cdr buffer-undo-list))
+     ))
+  (t
+   ;; for anything older than Emacs 19.7.    
+   ))
+
 
 ;;; @ end
 ;;;