;;; poe.el --- Portable Outfit for Emacsen; -*-byte-compile-dynamic: t;-*-
-;; 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, NEmacs, MULE, Emacs/mule, XEmacs
;; This file is part of APEL (A Portable Emacs Library).
;;; Code:
+(provide 'poe)
+
(defmacro defun-maybe (name &rest everything-else)
(or (and (fboundp name)
(not (get name 'defun-maybe)))
))
)))
-(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)
))
)))
)))
(defmacro defun-maybe-cond (name args &optional doc &rest everything-else)
- (unless (stringp doc)
- (setq everything-else (cons doc everything-else)
- doc nil)
- )
+ (or (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 (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)
- ))))
+ (` (or (fboundp (quote (, name)))
+ (progn
+ (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."
(require 'poe-18)
))
-
;;; @ Emacs 19.23 emulation
;;;
(set-buffer (window-buffer (minibuffer-window)))
(current-column)))
-
;;; @ Emacs 19.29 emulation
;;;
+(eval-when-compile (require 'static))
+
+;; `add-hook' and `remove-hook' are imported from Emacs 19.28
+;; (with additional `local' argument).
+(static-condition-case nil
+ (let (test-hook)
+ (add-hook 'test-hook 'test 'append 'local)
+ (remove-hook 'test-hook 'test 'local))
+ (void-function
+ ;; emulate add-hook/remove-hook for version 18.
+ (defun-maybe add-hook (hook function &optional append local)
+ "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.
+
+The optional fourth argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value
+\(LOCAL is only for emulation\).
+
+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.
+\[Emacs 19.29 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-maybe remove-hook (hook function &optional local)
+ "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'.
+
+The optional third argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value
+\(LOCAL is only for emulation\).
+\[Emacs 19.29 emulating function]"
+ (if (or (not (boundp hook))
+ (null (symbol-value hook))
+ (null function))
+ nil
+ (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))))
+ )
+ (wrong-number-of-arguments
+ ;; emulate `local' arg for version 19.28 and earlier.
+ (or (fboundp 'si:add-hook)
+ (progn
+ (fset 'si:add-hook (symbol-function 'add-hook))
+ (defun add-hook (hook function &optional append local)
+ "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.
+
+The optional fourth argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value
+\(LOCAL is only for emulation\).
+
+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.
+\[Emacs 19.29 emulating function]"
+ ;; the fourth argument LOCAL is simply ignored.
+ (si:add-hook hook function append))))
+
+ (or (fboundp 'si:remove-hook)
+ (progn
+ (fset 'si:remove-hook (symbol-function 'remove-hook))
+ (defun remove-hook (hook function &optional local)
+ "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'.
+
+The optional third argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value
+\(LOCAL is only for emulation\).
+\[Emacs 19.29 emulating function]"
+ ;; the third argument LOCAL is simply ignored.
+ (si:remove-hook hook function))))
+ ))
+
+(defun-maybe make-local-hook (hook)
+ "Make the hook HOOK local to the current buffer.
+This function is only for emulation.
+\[Emacs 19.29 emulating function]"
+ )
+
(defvar-maybe path-separator ":"
"Character used to separate concatenated paths.")
(setq list (cdr list)))
))
-(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 t)
- (list 'add-hook hook function append)
- ))
-
-(defmacro-maybe remove-local-hook (hook function)
- (if (fboundp 'make-local-hook)
- (list 'remove-hook hook function t)
- (list 'remove-hook hook function)
- ))
-
+(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))))
;;; @ Emacs 19.30 emulation
;;;
(cons 'if (cons cond (cons nil body))))
;; imported from Emacs 20.3.
+(defsubst-maybe caar (x)
+ "Return the car of the car of X."
+ (car (car x)))
+
+;; 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.
;;; @ end
;;;
-(provide 'poe)
-
;;; poe.el ends here
projects / elisp / apel.git / blobdiff