(provide 'poe)
+(or (boundp 'current-load-list) (setq current-load-list nil))
+
(put 'defun-maybe 'lisp-indent-function 'defun)
(defmacro defun-maybe (name &rest everything-else)
"Define NAME as a function if NAME is not defined.
(` (or (fboundp (quote (, name)))
(prog1
(defun (, name) (,@ everything-else))
+ ;; This `defun' will be compiled to `fset', which does
+ ;; not update `load-history'.
+ (setq current-load-list
+ (cons (quote (, name)) current-load-list))
(put (quote (, name)) 'defun-maybe t))))))
(put 'defmacro-maybe 'lisp-indent-function 'defun)
(` (or (fboundp (quote (, name)))
(prog1
(defmacro (, name) (,@ everything-else))
+ (setq current-load-list
+ (cons (quote (, name)) current-load-list))
(put (quote (, name)) 'defmacro-maybe t))))))
(put 'defsubst-maybe 'lisp-indent-function 'defun)
(` (or (fboundp (quote (, name)))
(prog1
(defsubst (, name) (,@ everything-else))
+ (setq current-load-list
+ (cons (quote (, name)) current-load-list))
(put (quote (, name)) 'defsubst-maybe t))))))
(defmacro defalias-maybe (symbol definition)
(` (or (fboundp (quote (, symbol)))
(prog1
(defalias (quote (, symbol)) (, definition))
+ (setq current-load-list
+ (cons (quote (, symbol)) current-load-list))
(put (quote (, symbol)) 'defalias-maybe t))))))
(defmacro defvar-maybe (name &rest everything-else)
(` (or (boundp (quote (, name)))
(prog1
(defvar (, name) (,@ everything-else))
+ ;; byte-compiler will generate code to update
+ ;; `load-history'.
(put (quote (, name)) 'defvar-maybe t))))))
(defmacro defconst-maybe (name &rest everything-else)
(` (or (boundp (quote (, name)))
(prog1
(defconst (, name) (,@ everything-else))
+ ;; byte-compiler will generate code to update
+ ;; `load-history'.
(put (quote (, name)) 'defconst-maybe t))))))
(defmacro defun-maybe-cond (name args &optional doc &rest everything-else)
(not (get name 'defun-maybe)))
(` (or (fboundp (quote (, name)))
(prog1
- (cond (,@ (mapcar (function
- (lambda (case)
- (list (car case)
- (if doc
- (` (defun (, name) (, args)
- (, doc)
- (,@ (cdr case))))
- (` (defun (, name) (, args)
- (,@ (cdr case))))))))
- everything-else)))
+ (cond
+ (,@ (mapcar
+ (function
+ (lambda (case)
+ (list (car case)
+ (if doc
+ (` (defun (, name) (, args)
+ (, doc)
+ (,@ (cdr case))))
+ (` (defun (, name) (, args)
+ (,@ (cdr case))))))))
+ everything-else)))
+ (setq current-load-list
+ (cons (quote (, name)) current-load-list))
(put (quote (, name)) 'defun-maybe t))))))
(defmacro defmacro-maybe-cond (name args &optional doc &rest everything-else)
(not (get name 'defmacro-maybe)))
(` (or (fboundp (quote (, name)))
(prog1
- (cond (,@ (mapcar (function
- (lambda (case)
- (list (car case)
- (if doc
- (` (defmacro (, name) (, args)
- (, doc)
- (,@ (cdr case))))
- (` (defmacro (, name) (, args)
- (,@ (cdr case))))))))
- everything-else)))
+ (cond
+ (,@ (mapcar
+ (function
+ (lambda (case)
+ (list (car case)
+ (if doc
+ (` (defmacro (, name) (, args)
+ (, doc)
+ (,@ (cdr case))))
+ (` (defmacro (, name) (, args)
+ (,@ (cdr case))))))))
+ everything-else)))
+ (setq current-load-list
+ (cons (quote (, name)) current-load-list))
(put (quote (, name)) 'defmacro-maybe t))))))
(defun subr-fboundp (symbol)
;; 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))
+
+;; `file-coding' was appeared in the spring of 1998, just before XEmacs
+;; 21.0. Therefore it is not provided in XEmacs with MULE versions 20.4
+;; or earlier.
+(if (and (featurep 'xemacs) (featurep 'mule))
+ (provide 'file-coding))
+
+;; 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)
+(def-edebug-spec defun-maybe-cond
+ (&define name lambda-list
+ [&optional stringp]
+ [&rest ([¬ eval] [&rest sexp])]
+ [&optional (eval [&optional ("interactive" interactive)] def-body)]
+ &rest (&rest sexp)))
+(def-edebug-spec defmacro-maybe-cond
+ (&define name lambda-list
+ [&rest ([¬ eval] [&rest sexp])]
+ [&optional (eval def-body)]
+ &rest (&rest sexp)))
;;; Emacs 20.1 emulation
(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
(defun-maybe rassoc (key list)
"Return non-nil if KEY is `equal' to the cdr of an element of LIST.
The value is actually the element of LIST whose cdr equals KEY.
+Elements of LIST that are not conses are ignored.
\[Emacs 19.29 emulating function]"
(catch 'found
(while list
- (if (equal (cdr (car list)) key)
- (throw 'found (car list)))
- (setq list (cdr list)))))
+ (cond ((not (consp (car list))))
+ ((equal (cdr (car list)) key)
+ (throw 'found (car list)) ))
+ (setq list (cdr list)) )))
;; imported from emacs-19.34/lisp/files.el.
(defun-maybe file-name-sans-extension (filename)
(cons 'progn body)
(list 'select-window 'save-selected-window-window))))
+(defun-maybe-cond convert-standard-filename (filename)
+ "Convert a standard file's name to something suitable for the current OS.
+This function's standard definition is trivial; it just returns the argument.
+However, on some systems, the function is redefined
+with a definition that really does change some file names.
+Under `windows-nt' or `ms-dos', it refers `filename-replacement-alist' and
+`filename-limit-length' for the basic filename and each parent directory name.
+\[Emacs 19.31 emulating function]"
+ ((memq system-type '(windows-nt ms-dos))
+ (require 'filename)
+ (let* ((names (split-string filename "/"))
+ (drive-name (car names))
+ (filter (function (lambda (string)
+ (filename-maybe-truncate-by-size
+ (filename-special-filter string))))))
+ (cond ((eq 1 (length names))
+ (funcall filter drive-name))
+ ((string-match "^[^/]:$" drive-name)
+ (concat drive-name "/" (mapconcat filter (cdr names) "/")))
+ (t (mapconcat filter names "/")))))
+ (t filename))
+
;;; @ Emacs 20.1 emulation
;;;
(static-condition-case nil
;; compile-time check.
(progn
- ;; XXX: current make process requires this file at compile-time,
- ;; so this test will be always success at compile-time.
+ ;; 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.
(static-condition-case nil
;; compile-time check.
(progn
- ;; XXX: current make process requires this file at compile-time,
- ;; so this test will be always success at compile-time.
+ ;; 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.
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]"
(if base
(logior base (car (cdr mask)))
)))))
- ((integerp event) event)
- ))
+ ((integerp event) event)))
)
projects / elisp / apel.git / blobdiff