Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

update.

  • Loading branch information...
commit 36feeb9bbb4bf7bddf38180b365486eb67cd3c66 1 parent 237fc25
morioka authored
Showing with 159 additions and 216 deletions.
  1. +0 −24 ChangeLog
  2. +1 −1  Makefile
  3. +103 −110 poe-18.el
  4. +0 −2  poe-xemacs.el
  5. +55 −64 poe.el
  6. +0 −15 poem-om.el
View
24 ChangeLog
@@ -1,27 +1,3 @@
-1998-11-07 MORIOKA Tomohiko <morioka@jaist.ac.jp>
-
- * APEL: Version 9.9 was released.
-
-1998-11-06 MORIOKA Tomohiko <morioka@jaist.ac.jp>
-
- * poe.el (combine-after-change-calls): fixed.
-
-1998-10-31 Mikio Nakajima <minakaji@osaka.email.ne.jp>
-
- * poe.el (combine-after-change-calls): New macro.
-
-1998-10-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
-
- * poe.el (defun-maybe-cond): New macro.
- (next-command-event): Use `defun-maybe-cond'.
- (cancel-undo-boundary): Use `defun-maybe-cond'.
-
-1998-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * poem-om.el (char-after): Redefine to change `POS' to optional
- argument.
-
-
1998-10-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* APEL: Version 9.8 was released.
View
2  Makefile
@@ -2,7 +2,7 @@
# Makefile for APEL.
#
-VERSION = 9.9
+VERSION = 9.8
TAR = tar
RM = /bin/rm -f
View
213 poe-18.el
@@ -24,6 +24,13 @@
;;; Code:
+(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)
+
(defvar-maybe data-directory exec-directory)
@@ -33,12 +40,76 @@
(defvar-maybe buffer-undo-list nil)
-;;; @ Lisp Language
+;;; @ hook
;;;
-;;; @@ list
+;; 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
;;;
+(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)
+
(defun delete (elt list)
"Delete by side effect any occurrences of ELT as a member of LIST.
The modified LIST is returned. Comparison is done with `equal'.
@@ -59,32 +130,15 @@ to be sure of changing the value of `foo'.
(rplacd 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)
-
-
-;;; @@ 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)
-
-;;; @ Compilation Features
+;;; @ function
;;;
-(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)))
+(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)
)
(defun byte-code-function-p (exp)
@@ -105,6 +159,11 @@ This function works by modifying `process-environment'."
))
)))
+(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)))
+ )
+
(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.
@@ -118,25 +177,6 @@ If NEW is a string, that is the `use instead' message."
fn)
-;;; @@ 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)
- )
-
-
-;;; @ text property
-;;;
-
-(defun set-text-properties (start end properties &optional object))
-
-(defun remove-text-properties (start end properties &optional object))
-
-
;;; @ file
;;;
@@ -222,7 +262,17 @@ If NOSORT is dummy for compatibility.
)
-;;; @ Display Features
+;;; @ mark
+;;;
+
+(or (fboundp 'si:mark)
+ (fset 'si:mark (symbol-function 'mark)))
+(defun mark (&optional force)
+ (si:mark)
+ )
+
+
+;;; @ mode-line
;;;
;;; Imported from Emacs 19.30.
@@ -304,6 +354,14 @@ With optional non-nil ALL, force redisplay of all mode-lines.
(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
;;;
@@ -322,71 +380,6 @@ 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)
- )
-
-
-;;; @ hook
-;;;
-
-;; 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)
- )))
-
;;; @ end
;;;
View
2  poe-xemacs.el
@@ -57,13 +57,11 @@ When called interactively, prompt for the name of the color to use."
(condition-case nil
(require 'overlay)
(error (defalias 'make-overlay 'make-extent)
- (defalias 'overlayp 'extentp)
(defalias 'overlay-put 'set-extent-property)
(defalias 'overlay-buffer 'extent-buffer)
(defun move-overlay (extent start end &optional buffer)
(set-extent-endpoints extent start end)
)
- (defalias 'delete-overlay 'detach-extent)
))
View
119 poe.el
@@ -95,27 +95,6 @@
))
)))
-(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 (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)
@@ -151,9 +130,14 @@
))
-;;; @ Emacs 19.23 emulation
+;;; @ Emacs 19 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
@@ -297,22 +281,6 @@ 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'."
@@ -363,9 +331,21 @@ See also `with-temp-file' and `with-output-to-string'."
(and (buffer-name (, temp-buffer))
(kill-buffer (, temp-buffer))))))))
-(defmacro-maybe combine-after-change-calls (&rest body)
- "Execute BODY."
- (cons 'progn 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))
;; imported from Emacs 20.3. (cl function)
(defun-maybe butlast (x &optional n)
@@ -497,23 +477,33 @@ as obsolete. [XEmacs emulating function]"
(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.
+ (cond
+ ((subr-fboundp 'string)
+ ;; for Emacs 20.3 or later
+ (defun-maybe 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]"
+ (read-event prompt t)
+ )
+ )
+ (t
+ (defun-maybe 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)
- ))
+ (message prompt)
+ (read-event)
+ )
+ ))
(defsubst-maybe character-to-event (ch)
"Convert keystroke CH into an event structure, replete with bucky bits.
@@ -541,18 +531,19 @@ If the event isn't a keypress, this returns nil.
;;; @ 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.
- ))
+(if (boundp 'buffer-undo-list)
+ ;; for Emacs 19.7 or later
+ (defun-maybe cancel-undo-boundary ()
+ "Cancel undo boundary. [MULE 2.3 emulating function]"
+ (if (and (consp buffer-undo-list)
+ ;; if car is nil.
+ (null (car buffer-undo-list)))
+ (setq buffer-undo-list (cdr buffer-undo-list))
+ ))
+ ;; for anything older than Emacs 19.7.
+ (defun-maybe cancel-undo-boundary ()
+ "Cancel undo boundary. [MULE 2.3 emulating function]")
+ )
;;; @ end
View
15 poem-om.el
@@ -272,21 +272,6 @@ If POS is out of range, the value is nil."
(si:char-before (or pos (point)))
)))))
-(if (subr-fboundp 'char-after)
- (condition-case err
- (char-after)
- (error
- (when (and (eq (car (get (car err) 'error-conditions))
- 'wrong-number-of-arguments)
- (not (boundp 'si:char-after)))
- (fset 'si:char-after (symbol-function 'char-after))
- (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)))
- )))))
-
;;; @@ obsoleted aliases
;;;
;;; You should not use them.
Please sign in to comment.
Something went wrong with that request. Please try again.